Recent Posts

Pages: [1] 2 3 ... 10

Scripting Languages / Re: ScriptBasic 3.0

« Last post by John on Today at 12:13:25 AM »

I found this Sokoban solver for my phone that is interesting. I would need to modify the game to allow this command string.

Scripting Languages / Re: ScriptBasic 3.0

« Last post by John on April 15, 2024, 07:24:56 PM »

I added the ScriptBasic games to the repository.

https://gitlab.com/scriptbasic/sb-dev-win32/-/tree/master/examples/games/Peter_Wirbelauer

Move the files in the lib and include directories to your ScriptBasic directories with the same name.

With the SBT / MT extension modules, you could use threads in your game design.

I've attached Peter's OxygenBasic include / source which this game engine is built on.

This should be a good start for those wishing to use ScriptBasic to develop games.

Open Forum / PlanetSquires Forum

« Last post by John on April 15, 2024, 01:42:41 PM »

Paul,

I would be happy to host a readonly version of your forum to preserve the work you have done. This would be hosted as a sub-domain of AllBASIC.info like the Retro BASIC forum and Charles's old OxygenBasic.org forum.

Send me an email if this is a direction that makes sense.

John

Scripting Languages / Re: ScriptBasic 3.0

« Last post by John on April 14, 2024, 10:53:28 PM »

If you're using the Windows 32 bit version of ScriptBasic then you might enjoy the games I converted to ScriptBasic but using DLLC to call Peter Wirbelauer's game DLL. I will push to the repo the five games I did using Peter's library.

The game has 30 Levels with each getting harder. If you push a box into a corner before covering a circle, game over. The spacebar resets the level.

The only thing I would like to see added to this game is storing the moves. If you achieve the level by coving all the circles, you can save the game under your initials and play it back again. (single step or auto)

Quote

Designated storage locations: In Sokomind Plus, some boxes and target circles are uniquely numbered. In Block-o-Mania, the boxes have different colours, and the goal is to push them onto squares with matching colours.

Code: ScriptBasic

' ScriptBasic SokoMouse
 
INCLUDE "sbsw.inc"
 
SUB Initialize
  SW_DrawBmp p1, 0, 0, 640, 480, 0
' SW_BmpText fo, 200, 8, "SokoMouse", 24, 24
  zA = 0
  Notified = FALSE
  CALL ShowLevel
  FOR bc = 0 TO 299
    xBox[bc] = 0
    yBox[bc] = 0
    rBox[bc] = 0
    zBox[bc] = 0
    iBox[bc] = 0
  NEXT
  zR = 0
  vR = 0
  pHead = 3
  Ready = 0
  sl = 0
  cV = 0
  cR = 0
  Steps = 0
  RasReg = 0
  KeyR = 0
  KeyL = 0
  KeyU = 0
  KeyD = 0
  BoxRas = 0
  Turn = 1
  zTurn = 0
END SUB
 
SUB LoadMaps
  SW_LoadBytes "Maps/Map" & lev & "-1.bin", Map1
  SW_LoadBytes "Maps/Map" & lev & "-2.bin", Map2
  SW_LoadBytes "Maps/Map" & lev & "-3.bin", Map3
END SUB  
  
SUB ShowLevel
  SW_Sprite s8, 480, 450, zA
  SW_Sprite s9, 576, 450, zA
  SW_BmpText fo, 520, 450, FORMAT("%~00~",lev), 24, 24
  vA += 1
  IF vA = 8 THEN
    vA = 0
    zA = zA + 1
    IF zA = 4 THEN zA = 0
  END IF
END SUB
 
SUB ShowMaps
  FOR icx = 0 TO 14
    FOR idx = 0 TO 19
      ibx = icx * 20 + idx
      IF ASC(Map1[ibx]) = 3 THEN SW_Sprite s1, idx * 32, icx * 32, 3
      IF ASC(Map3[ibx]) = 2 THEN SW_Sprite s1, idx * 32, icx * 32, 2
      IF ASC(Map2[ibx]) = 5 THEN SW_Sprite s2, idx * 32, icx * 32, zR
    NEXT
  NEXT
  vR += 1
  IF vR = 10 THEN
    vR = 0
    zR += 1
  END IF
  IF zR = 4 THEN zR = 0
END SUB
 
SUB FindHead
  FOR icx = 0 TO 14
    FOR idx = 0 TO 19
      ibx = icx * 20 + idx
      IF ASC(Map3[ibx]) = 6 THEN
        xHead = idx * 32
        yHead = icx * 32
        rHead = 0
        zHead = 0
        EXIT SUB
      END IF
    NEXT
  NEXT
END SUB
 
SUB AllDone
  IF Ready >= 1 THEN EXIT SUB
  FOR icx = 0 TO 14
    FOR idx = 0 TO 19
      ibx = icx * 20 + idx
      IF ASC(Map2[ibx]) = 5 AND ASC(Map3[ibx]) <> 4 THEN
        EXIT SUB
      END IF
    NEXT
  NEXT
  Ready = 2
  RasReg = 1
  Turn = 0
  pHead = 0
  rTurn = SW_Rnd(1, 2)
  xTurn = xHead
  yTurn = yHead
END SUB
 
SUB TurnHead
  IF Turn > 0 THEN EXIT SUB
  IF rTurn = 1 THEN
    SW_Sprite s6, xTurn, yTurn, zTurn
  ELSE IF rTurn = 2 THEN
    SW_Sprite s7, xTurn, yTurn, zTurn
  END IF
  zTurn = zTurn + 1
  IF zTurn = 64 THEN zTurn = 0
END SUB
 
SUB FlashBox
  FOR icx = 0 TO 14
    FOR idx = 0 TO 19
      ibx = icx * 20 + idx
      IF ASC(Map2[ibx]) = 5 AND ASC(Map3[ibx]) = 4 THEN
        SW_Sprite s4, idx * 32, icx * 32, cR
      END IF
    NEXT
  NEXT
  cV += 1
  IF cV = 10 THEN
    cV = 0
    cR += 1
  END IF
  IF cR = 4 THEN cR = 0
END SUB
 
SUB ScanBoxes
  IF BoxRas > 0 THEN EXIT SUB
  FOR icx = 0 TO 14
    FOR idx = 0 TO 19
      ibx = icx * 20 + idx
      IF ASC(Map3[ibx]) = 4 THEN
        iBox[ibx] = 1
        xBox[ibx] = idx * 32
        yBox[ibx] = icx * 32
        rBox[ibx] = 0
      END IF
    NEXT
  NEXT
END SUB
 
SUB ShowBoxes
  FOR ibx = 20 TO 280
    IF iBox[ibx] = 1 AND rBox[ibx] = 0 THEN
      SW_Sprite s1, xBox[ibx], yBox[ibx], 4
    ELSE IF iBox[ibx] = 1 AND rBox[ibx] = 1 THEN
      xBox[ibx] = xBox[ibx] + 2
      SW_Sprite s1, xBox[ibx], yBox[ibx], 4
      zBox[ibx] = zBox[ibx] + 2
      IF zBox[ibx] = 32 THEN
        zBox[ibx] = 0
        iBox[ibx] = 0
        icx = (yBox[ibx] * 20 + xBox[ibx]) / 32
        Map3[icx] = CHR(4)
      END IF
    ELSE IF iBox[ibx] = 1 AND rBox[ibx] = 2 THEN
      xBox[ibx] = xBox[ibx] - 2
      SW_Sprite s1, xBox[ibx], yBox[ibx], 4
      zBox[ibx] = zBox[ibx] + 2
      IF zBox[ibx] = 32 THEN
        zBox[ibx] = 0
        iBox[ibx] = 0
        icx = (yBox[ibx] * 20 + xBox[ibx]) / 32
        Map3[icx] = CHR(4)
      END IF
    ELSE IF iBox[ibx] = 1 AND rBox[ibx] = 3 THEN
      yBox[ibx] = yBox[ibx] - 2
      SW_Sprite s1, xBox[ibx], yBox[ibx], 4
      zBox[ibx] = zBox[ibx] + 2
      IF zBox[ibx] = 32 THEN
        zBox[ibx] = 0
        iBox[ibx] = 0
        icx = (yBox[ibx] * 20 + xBox[ibx]) / 32
        Map3[icx] = CHR(4)
      END IF
    ELSE IF iBox[ibx] = 1 AND rBox[ibx] = 4 THEN
      yBox[ibx] = yBox[ibx] + 2
      SW_Sprite s1, xBox[ibx], yBox[ibx], 4
      zBox[ibx] = zBox[ibx] + 2
      IF zBox[ibx] = 32 THEN
        zBox[ibx] = 0
        iBox[ibx] = 0
        icx = (yBox[ibx] * 20 + xBox[ibx]) / 32
        Map3[icx] = CHR(4)
      END IF
    END IF
  NEXT
END SUB
 
SUB ScanHead
  IF RasReg > 0 THEN EXIT SUB
  idx = xHead / 32
  icx = yHead / 32
  ibx = icx * 20 + idx
  IF ASC(Map3[ibx]) = 6 AND SW_Key(vk_right) AND ASC(Map3[ibx + 1]) = 4 AND ASC(Map3[ibx + 2]) = 0 AND KeyR = 0 THEN
    Map3[ibx] = CHR(0)
    Map3[ibx + 1] = CHR(6)
    rHead = 1
    pHead = 1
    BoxRas = 0
    xBox[ibx + 1] = xHead + 32
    yBox[ibx + 1] = yHead
    rBox[ibx + 1] = 1
    iBox[ibx + 1] = 1
    Steps += 1
    SW_PlayWav w2
  ELSE IF ASC(Map3[ibx]) = 6 AND SW_Key(vk_left) AND ASC(Map3[ibx - 1]) = 4 AND ASC(Map3[ibx - 2]) = 0 AND KeyL = 0 THEN
    Map3[ibx] = CHR(0)
    Map3[ibx - 1] = CHR(6)
    rHead = 2
    pHead = 2
    BoxRas = 0
    xBox[ibx - 1] = xHead - 32
    yBox[ibx - 1] = yHead
    rBox[ibx - 1] = 2
    iBox[ibx - 1] = 1
    Steps += 1
    SW_PlayWav w2
  ELSE IF ASC(Map3[ibx]) = 6 AND SW_Key(vk_up) AND ASC(Map3[ibx - 20]) = 4 AND ASC(Map3[ibx - 40]) = 0 AND KeyU = 0 THEN
    Map3[ibx] = CHR(0)
    Map3[ibx - 20] = CHR(6)
    rHead = 3
    pHead = 3
    BoxRas = 0
    xBox[ibx - 20] = xHead
    yBox[ibx - 20] = yHead - 32
    rBox[ibx - 20] = 3
    iBox[ibx - 20] = 1
    Steps += 1
    SW_PlayWav w2
  ELSE IF ASC(Map3[ibx]) = 6 AND SW_Key(vk_down) AND ASC(Map3[ibx + 20]) = 4 AND ASC(Map3[ibx + 40]) = 0 AND KeyD = 0 THEN
    Map3[ibx] = CHR(0)
    Map3[ibx + 20] = CHR(6)
    rHead = 4
    pHead = 4
    BoxRas = 0
    xBox[ibx + 20] = xHead
    yBox[ibx + 20] = yHead + 32
    rBox[ibx + 20] = 4
    iBox[ibx + 20] = 1
    Steps += 1
    SW_PlayWav w2
  ELSE IF ASC(Map3[ibx]) = 6 AND SW_Key(vk_right) AND ASC(Map3[ibx + 1]) = 0 AND KeyR = 0 THEN
    rHead = 1 
    pHead = 1
    Map3[ibx] = CHR(0)
    Map3[ibx + 1] = CHR(6)
    Steps += 1
    SW_PlayWav w1
  ELSE IF ASC(Map3[ibx]) = 6 AND SW_Key(vk_left) AND ASC(Map3[ibx - 1]) = 0 AND KeyL = 0 THEN
    rHead = 2
    pHead = 2
    Map3[ibx] = CHR(0)
    Map3[ibx - 1] = CHR(6)
    Steps += 1
    SW_PlayWav w1
  ELSE IF ASC(Map3[ibx]) = 6 AND SW_Key(vk_up) AND ASC(Map3[ibx - 20]) = 0 AND KeyU = 0 THEN
    rHead = 3
    pHead = 3
    Map3[ibx] = CHR(0)
    Map3[ibx - 20] = CHR(6)
    Steps += 1
    SW_PlayWav w1
  ELSE IF ASC(Map3[ibx]) = 6 AND SW_Key(vk_down) AND ASC(Map3[ibx + 20]) = 0 AND KeyD = 0 THEN
    rHead = 4
    pHead = 4
    Map3[ibx] = CHR(0)
    Map3[ibx + 20] = CHR(6)
    Steps += 1
    SW_PlayWav w1
  ELSE
    rHead = 0
  END IF
END SUB
 
SUB ShowHead
  IF rHead = 0 AND pHead = 1 THEN
    SW_Sprite s3, xHead, yHead, 3
  ELSE IF rHead = 0 AND pHead = 2 THEN
    SW_Sprite s3, xHead, yHead, 1
  ELSE IF rHead = 0 AND pHead = 3 THEN
    SW_Sprite s3, xHead, yHead, 0
  ELSE IF rHead = 0 AND pHead = 4 THEN
    SW_Sprite s3, xHead, yHead, 2
  ELSE IF rHead = 1 THEN
    xHead += 2
    SW_Sprite s3, xHead, yHead, 3
    RasReg += 2
    IF RasReg = 32 THEN
      RasReg = 0
      rHead = 0
    END IF
  ELSE IF rHead = 2 THEN
    xHead -= 2
    SW_Sprite s3, xHead, yHead, 1
    RasReg += 2
    IF RasReg = 32 THEN
      RasReg = 0
      rHead = 0
    END IF
  ELSE IF rHead = 3 THEN
    yHead -= 2
    SW_Sprite s3, xHead, yHead, 0
    RasReg += 2
    IF RasReg = 32 THEN
      RasReg = 0
      rHead = 0
    END IF
  ELSE IF rHead = 4 THEN
    yHead += 2
    SW_Sprite s3, xHead, yHead, 2
    RasReg += 2
    IF RasReg = 32 THEN
      RasReg = 0
      rHead = 0
    END IF
  END IF
END SUB
 
SUB MousePos
  xPos = FIX(SW_xMouse() / 32)
  yPos = FIX(SW_yMouse() / 32)
  IF SW_MouseButton() = 1 THEN
    IF xPos = 15 AND yPos = 14 AND lev > 1 AND ButtonC = 0 THEN
      lev -= 1
      ButtonC = 1
      SW_PlayWav w4
      Initialize
      LoadMaps
      FindHead
      EXIT SUB
    END IF
  END IF
  IF SW_MouseButton() = 1 THEN
    IF xPos = 18 AND yPos = 14 AND lev < 30 AND ButtonC = 0 THEN
      lev += 1
      ButtonC = 1
      SW_PlayWav w4
      Initialize
      LoadMaps
      FindHead
    END IF
  END IF
  IF SW_MouseButton() = 0 THEN ButtonC = 0
END SUB
 
 
' MAIN
 
SW_Window 640, 480, 1
SW_SetCaption "ScriptBasic SokoMouse"
 
SW_SetFps(60)
 
Q  = SW_LoadBmp("SokoMedia/sokomouse.bmp", 1)
p1 = SW_LoadBmp("SokoMedia/smbg.bmp", 1)
Fo = SW_LoadBmp("SokoMedia/FontStrip.bmp", 96)
s1 = SW_LoadBmp("SokoMedia/SokoStrip.bmp", 5)
s2 = SW_LoadBmp("SokoMedia/RundStrip.bmp", 4)
s3 = SW_LoadBmp("SokoMedia/HeadStrip.bmp", 4)
s4 = SW_LoadBmp("SokoMedia/BoxsStrip.bmp", 4)
s6 = SW_LoadBmp("SokoMedia/HeadStripR.bmp", 64)
s7 = SW_LoadBmp("SokoMedia/HeadStripL.bmp", 64)
s8 = SW_LoadBmp("SokoMedia/ArroStripL.bmp", 4)
s9 = SW_LoadBmp("SokoMedia/ArroStripR.bmp", 4)
 
w1 = "SokoMedia/move.wav"
w2 = "SokoMedia/push.wav"
w3 = "SokoMedia/done.wav"
w4 = "SokoMedia/clic.wav"
 
 
SW_Cls  0xCCCCCC 
SW_Sprite Q, 180, 60, 0
SW_BmpText fo, 205, 32, "SOKOMOUSE", 24, 24
SW_BmpText fo, 170, 428, "PRESS ANY KEY", 24, 24
SW_WaitKey
 
lev = 1
Initialize
LoadMaps
ShowLevel
FindHead
 
WHILE SW_Key(27) = 0
  ShowMaps
  IF sl THEN ShowLevel
  ScanBoxes
  ScanHead
  ShowBoxes
  ShowHead
  FlashBox
  AllDone
  MousePos
  TurnHead
  IF SW_Key(vk_space) THEN
    SW_BmpText fo, 64, 420, "Wait...", 24, 24
    Initialize
    LoadMaps
    FindHead
  END IF
  IF Ready = 2 AND NOT(Notified) THEN
    SW_BmpText fo, 64, 450, Steps & " moves to solve.", 20, 20
    SW_Sync
    SW_PlayWav w3
    sl = 1
    Notified = TRUE
  END IF
  BoxRas += 2
  IF BoxRas = 32 THEN BoxRas = 0
  IF SW_Key(vk_right) = 0 THEN KeyR = 1
  IF SW_Key(vk_right)THEN
    KeyR = 0
    SW_Wait(10)
  END IF
  IF SW_Key(vk_left) = 0 THEN KeyL = 1
  IF SW_Key(vk_left) THEN
    KeyL = 0
    SW_Wait(10)
  END IF
  IF SW_Key(vk_up) = 0 THEN KeyU = 1
  IF SW_Key(vk_up) THEN
    KeyU = 0
    SW_Wait(10)
  END IF
  IF SW_Key(vk_down) = 0 THEN KeyD = 1
  IF SW_Key(vk_down) THEN
    KeyD = 0
    SW_Wait(10)
  END IF
  SW_Sync
WEND
SW_CloseWindow
 

sbsw.inc

Code: ScriptBasic

' SIMPLE WINDOWS LIBRARY FOR SCRIPTBASIC (sw.inc) by PETER WIRBELAUER
 
DECLARE SUB LoadMap ALIAS "loadstring" LIB "t"
DECLARE SUB DLLC_File ALIAS "dllfile" LIB "DLLC"
DECLARE SUB DLLC_Proc ALIAS "dllproc" LIB "DLLC"
DECLARE SUB DLLC_Call ALIAS "dllcall" LIB "DLLC"
DECLARE SUB DLLC_OleStr ALIAS "dllostr" LIB "DLLC"
DECLARE SUB DLLC_DelOle ALIAS "dlldelo" LIB "DLLC"
 
GLOBAL CONST WHITE = 0xFFFFFF
GLOBAL CONST DKGRAY = 0x404040
GLOBAL CONST BLUE = 0xFF0000
GLOBAL CONST BOLD = 700
 
' Key Defs
GLOBAL CONST vk_space = 0x20
GLOBAL CONST vk_right = 0x27
GLOBAL CONST vk_left = 0x25
GLOBAL CONST vk_up = 0x26
GLOBAL CONST vk_down = 0x28
 
sw = DLLC_File("sw.dll")
ms = DLLC_File("winmm.dll")
 
' Simple Windows function definitions
 
Window = DLLC_Proc(sw, "Window i = (i width, i height, i mode)")
SetCaption = DLLC_Proc(sw, "SetCaption i = (c*capText)")
GetWidth = DLLC_Proc(sw, "GetWidth 1 = ()")
GetHeight = DLLC_Proc(sw, "GetHeight i = ()")
Key = DLLC_Proc(sw, "Key i = (i mKey)")
WaitKey = DLLC_Proc(sw, "WaitKey i = ( )")
GetKey = DLLC_Proc(sw, "GetKey i = ( )")
xMouse = DLLC_Proc(sw, "xMouse i = ( )")
Wait = DLLC_Proc(sw, "Wait i = (i msec)")
yMouse = DLLC_Proc(sw, "yMouse i = ( )") 
MouseButton = DLLC_Proc(sw, "MouseButton i = ( )")
Cls = DLLC_Proc(sw, "Cls i = (i color)")
DrawLine = DLLC_Proc(sw, "Line i = (i xPos, i yPos, i a, i b, i thickness, i color)")
DrawPoint = DLLC_Proc(sw, "DrawPoint i = (i xPos, i yPos, i width, i height, i color)")
SetPixel = DLLC_Proc(sw, "SetPixel i = (i xPos, i yPos, i color)")
Box = DLLC_Proc(sw, "Box i = (i xPos, i yPos, i w, i h, i thickness, i color)")
Circle = DLLC_Proc(sw, "Circle i = (i xPos, i yPos, i r1, i thickness, i color)")
FillCircle = DLLC_Proc(sw, "FillCircle i = (i xPos, i yPos, i r1, i color)")
Ellipse = DLLC_Proc(sw, "Ellipse i = (i xPos, i yPos, i r1, i r2, i thickness, i color)")
RGB = DLLC_Proc(sw, "RGB i = (i rValue, i gValue, i bValue)")
Rand = DLLC_Proc(sw, "Rnd i = (i minNumber, i maxNumber)")
SetText = DLLC_Proc(sw, "SetText i = (i xPos, i yPos, o text, i color)")
SetFont = DLLC_Proc(sw, "SetFont i = (i width, i height, i style, c*fontName)")
LoadBmp = DLLC_Proc(sw, "LoadBmp i = (c*bmpFile, i frames)")
Sprite = DLLC_Proc(sw, "Sprite i = (i idBmp, i xPos, i yPos, i frames)")
BmpText = DLLC_Proc(sw, "BmpText i = (i idBmp, i xPos, i yPos, o iText, i Zoom, i yZoom)")
DrawBmp = DLLC_Proc(sw, "DrawBmp i = (i idBmp, i xPos, i yPos, i xZoom, i yZoom, i frames)")
Sync = DLLC_Proc(sw, "Sync ( )")
Redraw = DLLC_Proc(sw, "Redraw ( )")
SetFps = DLLC_Proc(sw, "SetFps i = (i frames)")
PlayWav = DLLC_Proc(ms, "sndPlaySoundA i = (c*wavFile, i sync)")
CloseWindow = DLLC_Proc(sw, "CloseWindow i = ( )")
 
 
 
' Simple Windows wrapper functions
 
SUB SW_Window(width, height, mode)
  DLLC_Call(Window, width, height, mode)
END SUB
 
SUB SW_SetCaption(capText)
  DLLC_Call(SetCaption, capText)
END SUB
 
FUNCTION SW_GetWidth
  SW_GetWidth = DLLC_Call(GetWidth)
END FUNCTION
 
FUNCTION SW_GetHeight
  SW_GetHeight = DLLC_Call(GetHeight)
END FUNCTION
 
FUNCTION SW_Key(mKey)
  SW_Key = DLLC_Call(Key, mKey)
END FUNCTION
 
SUB SW_WaitKey
  DLLC_Call(WaitKey)
END SUB
 
FUNCTION SW_GetKey
  SW_GetKey = DLLC_Call(GetKey)
END FUNCTION
 
SUB SW_Wait(msec)
  DLLC_Call(Wait, msec)
END SUB
 
FUNCTION SW_xMouse 
  SW_xMouse = DLLC_Call(xMouse)
END FUNCTION  
 
FUNCTION SW_yMouse 
  SW_yMouse = DLLC_Call(yMouse)
END FUNCTION  
 
FUNCTION SW_MouseButton
  SW_MouseButton = DLLC_Call(MouseButton)
END FUNCTION
 
SUB SW_Cls(color)
  DLLC_Call(Cls, color)
END SUB
 
SUB SW_Line(xPos, yPos, a, b, thickness, color)
  DLLC_Call(DrawLine, xPos, yPos, a, b, thickness, color)
END SUB
 
SUB SW_DrawPoint(xPos, yPos, width, height, color)
  DLLC_Call(DrawPoint, xPos, yPos, width, height, color)
END SUB
 
SUB SW_SetPixel(xPos, yPos, color)
  DLLC_Call(SetPixel, xPos, yPos, color)
END SUB
 
SUB SW_Box(xPos, yPos, w, h, thickness, color)
  DLLC_Call(Box, xPos, yPos, w, h, thickness, color)
END SUB
 
SUB SW_Circle(xPos, yPos, r1, thickness, color)
  DLLC_Call(Circle, xPos, yPos, r1, thickness, color)
END SUB
 
SUB SW_FillCircle(xPos, yPos, r1, color)
  DLLC_Call(FillCircle, xPos, yPos, r1, color)
END SUB
 
SUB SW_Ellipse(xPos, yPos, r1, r2, thickness, color)
  DLLC_Call(Ellipse, xPos, yPos, r1, r2, thickness, color)
END SUB
 
FUNCTION SW_RGB(rValue, gValue, bValue)
  SW_RGB = DLLC_Call(RGB, rValue, gValue, bValue)
END FUNCTION
 
FUNCTION SW_Rnd(minNumber, maxNumber)
  SW_Rnd = DLLC_Call(Rand, minNumber, maxNumber)
END FUNCTION
 
SUB SW_SetText(xPos, yPos, text, color)
  LOCAL ole_text
  ole_text = DLLC_OleStr(text)
  DLLC_Call(SetText, xPos, yPos, ole_text, color)
  DLLC_DelOle(ole_text)
END SUB
 
SUB SW_SetFont(width, height, style, fontName)
  DLLC_Call(SetFont, width, height, style, fontName)
END SUB
 
FUNCTION SW_LoadBmp(bmpFile, frames)
  SW_LoadBmp = DLLC_Call(LoadBmp, bmpFile, frames)
END FUNCTION
 
SUB SW_LoadBytes(nName, Destination)
  LOCAL tmpstr
  tmpstr = LoadMap(nName)
  SPLITA tmpstr BY "" TO Destination
END SUB   
 
SUB SW_Sprite(idBmp, xPos, yPos, frames)
  DLLC_Call(Sprite, idBmp, xPos, yPos, frames)
END SUB
 
SUB SW_BmpText(idBmp, xPos, yPos, sb_iText, Zoom, yZoom)
  LOCAL ole_iText
  ole_iText = DLLC_OleStr(sb_iText)
  DLLC_Call(BmpText, idBmp, xPos, yPos, ole_iText, Zoom, yZoom)
  DLLC_DelOle(ole_iText)
END SUB  
 
SUB SW_DrawBmp(idBmp, xPos, yPos, xZoom, yZoom, frames)
  DLLC_Call(DrawBmp, idBmp, xPos, yPos, xZoom, yZoom, frames)
END SUB
 
SUB SW_Sync
  DLLC_Call(Sync)
END SUB
 
SUB SW_Redraw
  DLLC_Call(Redraw)
END SUB
 
SUB SW_SetFps(frames)
  DLLC_Call(SetFps, frames)
END SUB
 
SUB SW_PlayWav(sfn)
  DLLC_Call(PlayWav, sfn, 1)
END SUB
 
SUB SW_CloseWindow
  DLLC_Call(CloseWindow)
END SUB
 

Scripting Languages / Re: ScriptBasic 3.0

« Last post by John on April 14, 2024, 06:21:32 PM »

I figured out what the issue was with OxygenBasic calling functions with a 64 bit pointer. I replaced cdecl with ms64 and the program compiled and ran. There still is an issue passing a double (real) to O2.

Code: Text

' O2 SB Embed
 
% filename "o2sb64.exe"
includepath "$/inc/"
uses rtl64
 
% libScriba = "libScriba.dll"
indexbase 0
 
type SbData
  typ as dword
  siz as dword
  union {
    dbl as double
    lng as sys
    str as char*
    gen as sys
  }
end type
 
#define SBT_UNDEF  0
#define SBT_DOUBLE 1
#define SBT_LONG   2
#define SBT_STRING 3
#define SBT_ZCHAR  4
 
sys pProgram, iError, cArgs
sys f1, f2, v
sys n, m
sys qdat
SbData ReturnData, ArgData[3]
sbData pdat
 
sys sb=LoadLibrary libScriba
 
extern ms64
  bind sb
  {
  scriba_new
  scriba_SetStdin()
  scriba_SetStdout()
  scriba_SetEmbedPointer()
  scriba_LoadConfiguration
  scriba_destroy
  scriba_DestroySbData
  scriba_SetFileName
  scriba_LoadSourceProgram
  scriba_LoadProgramString
  scriba_Run
  scriba_GetVariable
  scriba_SetVariable
  scriba_LookupVariableByName
  scriba_LookupFunctionByName
  scriba_Call
  scriba_CallArg
  scriba_NewSbArgs
  scriba_CallArgEx
  scriba_DestroySbArgs
  scriba_DestroySbData
  scriba_NewSbString
  }
end extern
 
function newmem ms64 (sys le) as sys, export
  return getmemory le
end function
 
function freemem ms64 (sys p) export
  freememory p
end function
 
pProgram = scriba_new(@newmem, @freemem)
scriba_LoadConfiguration(pProgram, "C:\Windows\SCRIBA.INI")
scriba_SetFileName(pProgram, "test.sb")
scriba_LoadSourceProgram(pProgram)
scriba_Run(pProgram,"")
 
' Get Global Var  
sbdata *p  
v = scriba_LookupVariableByName(pProgram, "main::a")
scriba_GetVariable(pProgram, v, @@p)
print "A: " + str(p.lng)
 
' Create SB Variant Array
sbData *arg
@arg = scriba_NewSbArgs(pProgram,"i r s", 1, .2, "three")
print str(arg[0].lng) + " | " + str(arg[1].dbl) + " | " + arg[2].str
 
scriba_DestroySbArgs(pProgram, arg, 3)
scriba_DestroySbData(pProgram, arg)  
scriba_destroy(pProgram)
 

test.sb

Code: ScriptBasic

a = 99

Code: Text

type SbData
  typ as dword
  siz as dword
  union {
    dbl as double
    lng as sys
    str as char*
    gen as sys
  }
end type
 

I tried all the other O2 floating point types besides double and nothing works.

Scripting Languages / Re: ScriptBasic 3.0

« Last post by John on April 14, 2024, 05:16:37 PM »

If there are any OxygenBasic pros out there it would helpful to get this OxgenBasic 32 bit example of ScriptBasic embedding LIBSCRIBA working in O2 64 bit.

O2 SB 32 bit embedding example

Scripting Languages / Re: ScriptBasic 3.0

« Last post by John on April 14, 2024, 02:29:48 PM »

I've added the ODBC FetchSchema() function to the sb-dev-msvc repository branch. I've pushed the code to the repo and attached a Windows 64 bit ODBC extension module DLL.

Linux

Code: ScriptBasic

IMPORT odbc.bas
 
dbh = odbc::RealConnect("PSQL","postgres","<Password>")
SQL = "SELECT * FROM film LIMIT 1"
odbc::Query(dbh, SQL)     
odbc::FetchSchema(dbh, col) 
odbc::Close(dbh)
 
FOR x = 0 TO UBOUND(col) STEP 5
  PRINT FORMAT("Column Name: %s, Type: %i, Size: %i, Digits: %i, Nullable: %i\n", col[x], col[x + 1], col[x + 2], col[x + 3], col[x + 4])
NEXT
 

jrs@linux-dev:~/sb/examples$ scriba getschema.sb Column Name: film_id, Type: 4, Size: 10, Digits: 0, Nullable: 0 Column Name: title, Type: 12, Size: 255, Digits: 0, Nullable: 0 Column Name: description, Type: -1, Size: 8190, Digits: 0, Nullable: 1 Column Name: release_year, Type: 4, Size: 10, Digits: 0, Nullable: 1 Column Name: language_id, Type: 5, Size: 5, Digits: 0, Nullable: 0 Column Name: rental_duration, Type: 5, Size: 5, Digits: 0, Nullable: 0 Column Name: rental_rate, Type: 2, Size: 4, Digits: 2, Nullable: 0 Column Name: length, Type: 5, Size: 5, Digits: 0, Nullable: 1 Column Name: replacement_cost, Type: 2, Size: 5, Digits: 2, Nullable: 0 Column Name: rating, Type: 12, Size: 255, Digits: 0, Nullable: 1 Column Name: last_update, Type: 93, Size: 26, Digits: 6, Nullable: 0 Column Name: special_features, Type: 12, Size: 255, Digits: 0, Nullable: 1 Column Name: fulltext, Type: 12, Size: 255, Digits: 0, Nullable: 0 jrs@linux-dev:~/sb/examples$

Windows 64 Bit

Code: ScriptBasic

IMPORT odbc.bas
 
dbh = ODBC::RealConnect("SB64","","")
 
ODBC::query(dbh, "SELECT TOP 1 * FROM TaskEntry")
 
odbc::FetchSchema(dbh, col) 
odbc::Close(dbh)
 
FOR x = 0 TO UBOUND(col) STEP 5
  PRINT FORMAT("Column Name: %s, Type: %i, Size: %i, Digits: %i, Nullable: %i\n", col[x], col[x + 1], col[x + 2], col[x + 3], col[x + 4])
NEXT
 

C:\ScriptBasic64\examples>scriba fetchschema.sb Column Name: GridSort, Type: -9, Size: 40, Digits: 0, Nullable: 0 Column Name: ClientCode, Type: -9, Size: 25, Digits: 0, Nullable: 0 Column Name: TaskCode, Type: -9, Size: 30, Digits: 0, Nullable: 0 Column Name: TaskDate, Type: -9, Size: 15, Digits: 0, Nullable: 0 Column Name: Billable, Type: 2, Size: 4, Digits: 2, Nullable: 1 Column Name: NonBillable, Type: 2, Size: 4, Digits: 2, Nullable: 1 Column Name: DiscoveryDemo, Type: 2, Size: 4, Digits: 2, Nullable: 1 Column Name: Bill, Type: -8, Size: 1, Digits: 0, Nullable: 0 Column Name: TaskNotes, Type: -10, Size: 1073741823, Digits: 0, Nullable: 0 Column Name: BillingComplete, Type: -8, Size: 1, Digits: 0, Nullable: 0 C:\ScriptBasic64\examples>

ODBC SQL Column Type Values
ODBC JDBC Data Type -11 -11 GUID -7 -7 BIT -6 -6 TINYINT -5 -5 BIGINT -4 -4 LONGVARBINARY -3 -3 VARBINARY -2 -2 BINARY -1 -1 LONGVARCHAR 0 0 Unknown type 1 1 CHAR 2 2 NUMERIC 3 3 DECIMAL 4 4 INTEGER 5 5 SMALLINT 6 6 FLOAT 7 7 REAL 8 8 DOUBLE 9 91 DATE 10 92 TIME 11 93 TIMESTAMP 12 12 VARCHAR Unicode SQL types for ODBC applications working with multibyte character sets, such as in Chinese, Hebrew, Japanese, or Korean locales. ODBC Data Type -10 WLONGVARCHAR -9 WVARCHAR

Remember to add the FetchSchema DECLARE to your odbc.bas include file. It's added if you build from source.

Scripting Languages / Re: ScriptBasic 3.0

« Last post by John on April 13, 2024, 09:44:10 PM »

All the modules released on all platforms are now working. If you have time to give ScriptBasic a try and let me know if you find any issue that would be great. I need to get back to a project I'm working on so that's it from me for a while.

Scripting Languages / Re: ScriptBasic 3.0

« Last post by John on April 13, 2024, 08:40:34 PM »

Everything works fine with the changes I made on the Linux side on Windows 64 bit MSVC. I pushed the change to the ScriptBasic repository.

Code: ScriptBasic

IMPORT odbc.bas
 
dbh = ODBC::RealConnect("SB64","","")
 
ODBC::query(dbh, "SELECT * FROM TaskEntry")
 
WHILE ODBC::FetchHash(dbh,column)
  PRINT column{"ClientCode"}," - ",column{"TaskCode"},"\n"
WEND
 
ODBC::Close(dbh)

C:\ScriptBasic64\examples>scriba sql_odbc.sb 3FCONST - SPI-100-SERVICE AC PRO - SPI-100-SERVICE AC PRO - SPI-100-NC AC PRO - SPI-100-DIS/DEM AC PRO - SPI-100-SERVICE AC PRO - SPI-100-DIS/DEM AC PRO - SPI-100-DIS/DEM AC PRO - SPI-100-SERVICE AC PRO - SPI-100-SERVICE AC PRO - SPI-100-NC BACKLAN - SPI-100-SERVICE BACKLAN - SPI-100-DIS/DEM BACKLAN - SPI-100-NC C:\ScriptBasic64\examples>

Scripting Languages / Re: ScriptBasic 3.0

« Last post by John on April 13, 2024, 07:53:43 PM »

I found the the issue with FetchHash(). I'm going to try these changes on the Windows 64 MSVC version to make sure it works there as well. If all is good, I'll push the changes to the repo.

Code: C

  SQLULEN ColSize; // JRS
// SQLUINTEGER ColSize;
 

Code: ScriptBasic

IMPORT odbc.bas
 
ON ERROR GOTO Ouch
dbh = ODBC::RealConnect("PSQL","postgres","<Password>")
 
ODBC::Query(dbh, "SELECT * FROM film LIMIT 10")
 
WHILE ODBC::FetchHash(dbh,column)
  PRINT column{"title"}," - ",column{"description"}, "\n"
WEND
 
Done:
ODBC::Close(dbh)
END
 
Ouch:
PRINT "DEBUG: ", ODBC::Error(dbh), "\n"
GOTO Done
 

Code: Text

jrs@linux-dev:~/sb/examples$ scriba sql_odbc.sb
Chamber Italian - A Fateful Reflection of a Moose And a Husband who must Overcome a Monkey in Nigeria
Grosse Wonderful - A Epic Drama of a Cat And a Explorer who must Redeem a Moose in Australia
Airport Pollock - A Epic Tale of a Moose And a Girl who must Confront a Monkey in Ancient India
Bright Encounters - A Fateful Yarn of a Lumberjack And a Feminist who must Conquer a Student in A Jet Boat
Academy Dinosaur - A Epic Drama of a Feminist And a Mad Scientist who must Battle a Teacher in The Canadian Rockies
Ace Goldfinger - A Astounding Epistle of a Database Administrator And a Explorer who must Find a Car in Ancient China
Adaptation Holes - A Astounding Reflection of a Lumberjack And a Car who must Sink a Lumberjack in A Baloon Factory
Affair Prejudice - A Fanciful Documentary of a Frisbee And a Lumberjack who must Chase a Monkey in A Shark Tank
African Egg - A Fast-Paced Documentary of a Pastry Chef And a Dentist who must Pursue a Forensic Psychologist in The Gulf of Mexico
Agent Truman - A Intrepid Panorama of a Robot And a Boy who must Escape a Sumo Wrestler in Ancient China
jrs@linux-dev:~/sb/examples$ 
 

Pages: [1] 2 3 ... 10

AllBASIC

News:

Recent Posts

Scripting Languages / Re: ScriptBasic 3.0

Scripting Languages / Re: ScriptBasic 3.0

Open Forum / PlanetSquires Forum

Scripting Languages / Re: ScriptBasic 3.0

Scripting Languages / Re: ScriptBasic 3.0

Scripting Languages / Re: ScriptBasic 3.0

Scripting Languages / Re: ScriptBasic 3.0

Scripting Languages / Re: ScriptBasic 3.0

Scripting Languages / Re: ScriptBasic 3.0

Scripting Languages / Re: ScriptBasic 3.0