Recent Posts

Pages: 1 ... 4 5 [6] 7 8 ... 10

ScriptBasic Blog / Re: ScriptBasic 3.0

« Last post by John on April 21, 2024, 08:15:11 PM »

Here is an older IUP demo I converted to ScriptBasic. This shows some of the other controls and using code to create bitmap images for buttons.

Code: ScriptBasic

' IUP sample.sb
 
IMPORT iup.bas
 
GLOBAL CONST IUP_CENTER = 0xFFFF
GLOBAL CONST IUP_TITLE = "TITLE"
GLOBAL CONST IUP_VALUE = "VALUE"
GLOBAL CONST IUP_SIZE = "SIZE"
GLOBAL CONST IUP_EXPAND = "EXPAND"
GLOBAL CONST IUP_DROPDOWN = "DROPDOWN"
GLOBAL CONST IUP_POSX = "POSX"
GLOBAL CONST IUP_POSY = "POSY"
GLOBAL CONST IUP_BGCOLOR = "BGCOLOR"
GLOBAL CONST IUP_MARGIN = "MARGIN"
GLOBAL CONST IUP_ALIGNMENT = "ALIGNMENT"
GLOBAL CONST IUP_GAP = "GAP"
GLOBAL CONST IUP_MENU = "MENU"
 
img_bits1 = """
 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1
,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,1
,1,1,1,1,1,1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,1,1
,1,1,1,1,1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,1,1,1
,1,1,1,1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,1,1,1,1
,1,1,1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,1,1,1,1,1
,1,1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,1,1,1,1,1,1
,1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,1,1,1,1,1,1,1
,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2
,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2
,2,2,2,0,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2
,2,2,2,0,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2
,2,2,2,0,2,0,2,0,2,2,0,2,2,2,0,0,0,2,2,2,0,0,2,0,2,2,0,0,0,2,2,2
,2,2,2,0,2,0,0,2,0,0,2,0,2,0,2,2,2,0,2,0,2,2,0,0,2,0,2,2,2,0,2,2
,2,2,2,0,2,0,2,2,0,2,2,0,2,2,2,2,2,0,2,0,2,2,2,0,2,0,2,2,2,0,2,2
,2,2,2,0,2,0,2,2,0,2,2,0,2,2,0,0,0,0,2,0,2,2,2,0,2,0,0,0,0,0,2,2
,2,2,2,0,2,0,2,2,0,2,2,0,2,0,2,2,2,0,2,0,2,2,2,0,2,0,2,2,2,2,2,2
,2,2,2,0,2,0,2,2,0,2,2,0,2,0,2,2,2,0,2,0,2,2,0,0,2,0,2,2,2,0,2,2
,2,2,2,0,2,0,2,2,0,2,2,0,2,2,0,0,0,0,2,2,0,0,2,0,2,2,0,0,0,2,2,2
,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,0,2,2,2,2,2,2,2,2
,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,0,2,2,2,0,2,2,2,2,2,2,2,2
,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,0,0,0,2,2,2,2,2,2,2,2,2
,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2
,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2
,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1
,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1
,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1
,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1
,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
"""
 
img_bits2 = """
 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,2
,2,2,2,2,2,2,2,2,2,2,2,2,2,2,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,2,2
,2,2,2,2,2,2,2,2,2,2,2,2,2,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,2,2,2
,2,2,2,2,2,2,2,2,2,2,2,2,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,2,2,2,2
,2,2,2,2,2,2,2,2,2,2,2,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,2,2,2,2,2
,2,2,2,2,2,2,2,2,2,2,3,3,3,3,1,1,3,3,3,3,3,3,3,3,3,3,2,2,2,2,2,2
,2,2,2,2,2,2,2,2,2,3,3,3,3,3,1,1,3,3,3,3,3,3,3,3,3,2,2,2,2,2,2,2
,2,2,2,2,2,2,2,2,3,3,3,3,3,3,1,1,3,3,3,3,3,3,3,3,2,2,2,2,2,2,2,2
,3,3,3,3,3,3,3,3,3,3,3,3,3,3,1,1,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3
,3,3,3,3,3,3,3,3,3,3,3,3,3,3,1,1,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3
,3,3,3,0,3,3,3,3,3,3,3,3,3,3,1,1,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3
,3,3,3,0,3,3,3,3,3,3,3,3,3,3,1,1,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3
,3,3,3,0,3,0,3,0,3,3,0,3,3,3,1,1,0,3,3,3,0,0,3,0,3,3,0,0,0,3,3,3
,3,3,3,0,3,0,0,3,0,0,3,0,3,0,1,1,3,0,3,0,3,3,0,0,3,0,3,3,3,0,3,3
,3,3,3,0,3,0,3,3,0,3,3,0,3,3,1,1,3,0,3,0,3,3,3,0,3,0,3,3,3,0,3,3
,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
,3,3,3,0,3,0,3,3,0,3,3,0,3,0,1,1,3,0,3,0,3,3,0,0,3,0,3,3,3,0,3,3
,3,3,3,0,3,0,3,3,0,3,3,0,3,3,1,1,0,0,3,3,0,0,3,0,3,3,0,0,0,3,3,3
,3,3,3,3,3,3,3,3,3,3,3,3,3,3,1,1,3,3,3,3,3,3,3,0,3,3,3,3,3,3,3,3
,3,3,3,3,3,3,3,3,3,3,3,3,3,3,1,1,3,3,3,0,3,3,3,0,3,3,3,3,3,3,3,3
,3,3,3,3,3,3,3,3,3,3,3,3,3,3,1,1,3,3,3,3,0,0,0,3,3,3,3,3,3,3,3,3
,3,3,3,3,3,3,3,3,3,3,3,3,3,3,1,1,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3
,3,3,3,3,3,3,3,3,3,3,3,3,3,3,1,1,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3
,2,2,2,2,2,2,2,3,3,3,3,3,3,3,1,1,3,3,3,3,3,2,2,2,2,2,2,2,2,2,2,2
,2,2,2,2,2,2,3,3,3,3,3,3,3,3,1,1,3,3,3,3,2,2,2,2,2,2,2,2,2,2,2,2
,2,2,2,2,2,3,3,3,3,3,3,3,3,3,3,3,3,3,3,2,2,2,2,2,2,2,2,2,2,2,2,2
,2,2,2,2,3,3,3,3,3,3,3,3,3,3,3,3,3,3,2,2,2,2,2,2,2,2,2,2,2,2,2,2
,2,2,2,3,3,3,3,3,3,3,3,3,3,3,3,3,3,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2
,2,2,3,3,3,3,3,3,3,3,3,3,3,3,3,3,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2
,2,3,3,3,3,3,3,3,3,3,3,3,3,3,3,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2
,3,3,3,3,3,3,3,3,3,3,3,3,3,3,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2
"""
 
SUB init_dialog
 
  img = Iup::Image(32,32, Iup::CreateImg(img_bits1))
  Iup::SetHandle ("img1", img)
  Iup::SetAttribute (img, "0", "0 0 0")
  Iup::SetAttribute (img, "1", "BGCOLOR")
  Iup::SetAttribute (img, "2", "255 0 0")
 
  img = Iup::Image(32,32, Iup::CreateImg(img_bits2))
  Iup::SetHandle ("img2", img)
  Iup::SetAttribute (img, "0", "0 0 0")
  Iup::SetAttribute (img, "1", "0 255 0")
  Iup::SetAttribute (img, "2", "BGCOLOR")
  Iup::SetAttribute (img, "3", "255 0 0")
 
  mnu = Iup::Menu( _
  Iup::Submenu("IupSubmenu 1",Iup::Menu( _
      Iup::SetAttributes(Iup::Item("IupItem 1 Checked"), "VALUE=ON"), _
      Iup::Separator(), _
      Iup::SetAttributes(Iup::Item("IupItem 2 Disabled"), "ACTIVE=NO"))), _
    Iup::Item("IupItem 3"), _
    Iup::Item("IupItem 4"))
  Iup::SetHandle("mnu",mnu)
 
  _frm_1 = Iup::Frame( _
    Iup::Vbox( _
      Iup::Button("Button Text"), _
      Iup::SetAttributes(Iup::Button(), "IMAGE=img1"), _
      Iup::SetAttributes(Iup::Button(), "IMAGE=img1,IMPRESS=img2")))
  Iup::SetAttribute(_frm_1,IUP_TITLE,"IupButton")
 
  _frm_2 = Iup::Frame( _
    Iup::Vbox( _
      Iup::Label("Label Text"), _
      Iup::SetAttributes(Iup::Label(""), "SEPARATOR=HORIZONTAL"), _
      Iup::SetAttributes(Iup::Label(""), "IMAGE=img1")))
  Iup::SetAttribute(_frm_2,IUP_TITLE,"IupLabel")
 
  _frm_3 = Iup::Frame( _
    Iup::Vbox( _
      Iup::SetAttributes(Iup::Toggle("Toggle Text"), "VALUE=ON"), _
      Iup::SetAttributes(Iup::Toggle(""), "IMAGE=img1,IMPRESS=img2"), _
      Iup::SetAttributes(Iup::Frame(Iup::Radio(Iup::Vbox( _
        Iup::Toggle("Toggle Text"), _
        Iup::Toggle("Toggle Text")))), "TITLE=IupRadio")))
  Iup::SetAttribute(_frm_3,IUP_TITLE,"IupToggle")
 
  _text_1 = Iup::Text()
  Iup::SetAttribute(_text_1,IUP_VALUE,"IupText Text")
  Iup::SetAttribute(_text_1,IUP_SIZE,"80x")
 
  _ml_1 = Iup::MultiLine()
  Iup::SetAttribute(_ml_1,IUP_VALUE,"IupMultiline Text\nSecond Line\nThird Line")
  Iup::SetAttribute(_ml_1,IUP_EXPAND,"YES")
  Iup::SetAttribute(_ml_1,IUP_SIZE,"80x60")
 
  _frm_4 = Iup::Frame(Iup::Vbox( _
    _text_1, _
    _ml_1))
  Iup::SetAttribute(_frm_4,IUP_TITLE,"IupText/IupMultiline")
 
  _list_1 = Iup::List()
  Iup::SetAttribute(_list_1,IUP_EXPAND,"YES")
  Iup::SetAttribute(_list_1,IUP_VALUE,"1")
  Iup::SetAttribute(_list_1,"1","Item 1 Text")
  Iup::SetAttribute(_list_1,"2","Item 2 Text")
  Iup::SetAttribute(_list_1,"3","Item 3 Text")
 
  _list_2 = Iup::List()
  Iup::SetAttribute(_list_2,IUP_DROPDOWN,"YES")
  Iup::SetAttribute(_list_2,IUP_EXPAND,"YES")
  Iup::SetAttribute(_list_2,IUP_VALUE,"2")
  Iup::SetAttribute(_list_2,"1","Item 1 Text")
  Iup::SetAttribute(_list_2,"2","Item 2 Text")
  Iup::SetAttribute(_list_2,"3","Item 3 Text")
 
  _list_3 = Iup::List()
  Iup::SetAttribute(_list_3,"EDITBOX","YES")
  Iup::SetAttribute(_list_3,IUP_EXPAND,"YES")
  Iup::SetAttribute(_list_3,IUP_VALUE,"3")
  Iup::SetAttribute(_list_3,"1","Item 1 Text")
  Iup::SetAttribute(_list_3,"2","Item 2 Text")
  Iup::SetAttribute(_list_3,"3","Item 3 Text")
 
  _frm_5 =  Iup::Frame(Iup::Vbox( _
      _list_1, _
      _list_2, _
      _list_3))
  Iup::SetAttribute(_frm_5,IUP_TITLE,"IupList")
 
  _hbox_1 = Iup::Hbox( _
    _frm_1, _
    _frm_2, _
    _frm_3, _
    _frm_4, _
    _frm_5)
 
  _cnv_1 = Iup::Canvas()
  Iup::SetAttribute(_cnv_1,IUP_POSX,"0.0")
  Iup::SetAttribute(_cnv_1,IUP_POSY,"0.0")
  Iup::SetAttribute(_cnv_1,IUP_BGCOLOR,"128 255 0")
 
  _vbox_1 = Iup::Vbox( _
    _hbox_1, _
    _cnv_1)
  Iup::SetAttribute(_vbox_1,IUP_MARGIN,"5x5")
  Iup::SetAttribute(_vbox_1,IUP_ALIGNMENT,"ARIGHT")
  Iup::SetAttribute(_vbox_1,IUP_GAP,"5")
 
  dlg = Iup::Dialog(_vbox_1)
  Iup::SetHandle("dlg",dlg)
  Iup::SetAttribute(dlg,IUP_MENU,"mnu")
  Iup::SetAttribute(dlg,IUP_TITLE,"IupDialog Title")
 
END SUB
 
' MAIN
 
  Iup::Open()
  init_dialog()
  Iup::Show(Iup::GetHandle("dlg"))
  Iup::MainLoop()
  Iup::Close()
 

ScriptBasic Blog / Re: ScriptBasic 3.0

« Last post by John on April 21, 2024, 06:36:00 PM »

A simple editor example.

Code: ScriptBasic

' IUP Simple Editor
 
IMPORT iup.bas
 
CONST IUP_CENTER = 0xFFFF
CONST IUP_DEFAULT = -2
 
 
FUNCTION Open_CB
  LOCAL filedlg, filename, och, olen, fstr
  filedlg = IUP::FileDlg()
  IUP::SetAttribute(filedlg, "DIALOGTYPE", "OPEN")
  IUP::SetAttribute(filedlg, "EXTFILTER", "Text Files|*.txt|All Files|*.*|")
  IUP::Popup(filedlg, IUP_CENTER, IUP_CENTER)
  IF IUP::GetInt(filedlg, "STATUS") <> -1 THEN
    filename = IUP::GetAttribute(filedlg, "VALUE")
    och = FREEFILE()
    OPEN filename FOR BINARY AS och
    olen = FILELEN(filename)
    fstr = INPUT(olen, och)
    IUP::StoreAttribute(multitext, "VALUE", fstr)
    CLOSE(och)
  END IF
  IUP::Destroy(filedlg)
  Open_CB = IUP_DEFAULT
END FUNCTION
 
 
FUNCTION SaveAs_CB
  LOCAL filedlg, filename, sch, fstr
  filedlg = IUP::FileDlg()
  IUP::SetAttribute(filedlg, "DIALOGTYPE", "SAVE")
  IUP::SetAttribute(filedlg, "EXTFILTER", "Text Files|*.txt|All Files|*.*|")
  IUP::Popup(filedlg, IUP_CENTER, IUP_CENTER)
  IF IUP::GetInt(filedlg, "STATUS") <> -1 THEN
    filename = IUP::GetAttribute(filedlg, "VALUE")
    fstr = IUP::GetAttribute(multitext, "VALUE")
    sch = FREEFILE()
    OPEN filename FOR BINARY AS sch
    PRINT #sch, fstr
    CLOSE(sch)
  END IF
  IUP::Destroy(filedlg)
  SaveAs_CB = IUP_DEFAULT
END FUNCTION
 
 
FUNCTION Font_CB
  LOCAL fontdlg, font
  fontdlg = IUP::FontDlg()
  font = IUP::GetAttribute(multitext, "FONT")
  font &= CHR(0)
  IUP::StoreAttribute(fontdlg, "VALUE", font)
  IUP::Popup(fontdlg, IUP_CENTER, IUP_CENTER)
  IF IUP::GetInt(fontdlg, "STATUS") = 1 THEN
    font = IUP::GetAttribute(fontdlg, "VALUE")
    IUP::StoreAttribute(multitext, "FONT", font)
  END IF
  IUP::Destroy(fontdlg)
  Font_CB = IUP_DEFAULT
END FUNCTION
 
 
FUNCTION About_CB
  IUP::Message("About", "   Simple Editor\n\nIUP ScriptBasic Binding")
  About_CB = IUP_DEFAULT
END FUNCTION
 
 
FUNCTION TextPos
  col = IUP::GetTextX()
  lin = IUP::GetTextY()
  IUP::SetAttribute(lbl_statusbar, "TITLE", "Lin " & lin & ", Col " & col)
' PRINT "Lin " & lin & ", Col " & col, "\n"
  TextPos = IUP_DEFAULT
END FUNCTION  
 
FUNCTION Find_CB
  find_dlg = Iup::GetAttribute(item_find, "FIND_DIALOG")
  config = Iup::GetAttribute(multitext, "CONFIG")
  Iup::Show(config)
  Find_CB = IUP_DEFAULT
END FUNCTION  
 
  
SUB Win_exit
  Iup::ExitLoop = TRUE
END SUB
 
 
' *** MAIN ***
 
IUP::Open
IUP::ImageLibOpen()
 
 
multitext = IUP::Text()
tbox = IUP::Vbox(multitext)
IUP::SetAttribute(multitext, "MULTILINE", "YES")
IUP::SetAttribute(multitext, "EXPAND", "YES")
' IUP::SetAttribute(multitext, "VISIBLECOLUMNS", "20")
Iup::SetCallback(multitext, "CARET_CB", ADDRESS(TextPos()))
 
lbl_statusbar = IUP::Label("Lin 1, Col 1")
IUP::SetAttribute(lbl_statusbar, "NAME", "STATUSBAR")
IUP::SetAttribute(lbl_statusbar, "EXPAND", "HORIZONTAL")
IUP::SetAttribute(lbl_statusbar, "PADDING", "10x5")
 
item_open = IUP::Item("Open")
btn_open = IUP::Button()
IUP::SetAttribute(btn_open, "IMAGE", "IUP_FileOpen")
IUP::SetAttribute(btn_open, "FLAT", "Yes")
IUP::SetAttribute(btn_open, "CANFOCUS", "No")
 
item_saveas = IUP::Item("Save As")
btn_save = IUP::Button("")
IUP::SetAttribute(btn_save, "IMAGE", "IUP_FileSave")
IUP::SetAttribute(btn_save, "FLAT", "Yes")
IUP::SetAttribute(btn_save, "CANFOCUS", "No")
 
item_exit = IUP::Item("Exit")
 
item_find = IUP::Item("Find...")
btn_find = IUP::Button("")
IUP::SetAttribute(btn_find, "IMAGE", "IUP_EditFind")
IUP::SetAttribute(btn_find, "FLAT", "Yes")
IUP::SetAttribute(btn_find, "CANFOCUS", "No")
 
toolbar_hb = IUP::Hbox( _
    btn_open, _
    btn_save, _
    IUP::SetAttributes(IUP::Label(), "SEPARATOR=VERTICAL"), _
    btn_find)
 
IUP::SetAttribute(toolbar_hb, "MARGIN", "5x5")
IUP::SetAttribute(toolbar_hb, "GAP", "2")
 
item_goto = IUP::Item("Go To...")
item_font = IUP::Item("Font...")
item_about = IUP::Item("About...")
 
Iup::SetCallback(item_exit,"ACTION", ADDRESS(Win_exit()))
IUP::SetCallback(item_open, "ACTION", ADDRESS(Open_CB()))
IUP::SetCallback(item_saveas, "ACTION", ADDRESS(SaveAs_CB()))
IUP::SetCallback(item_font, "ACTION", ADDRESS(Font_CB()))
IUP::SetCallback(item_about, "ACTION", ADDRESS(About_CB()))
IUP::SetCallback(item_find, "ACTION", ADDRESS(Find_CB()))
 
file_menu = IUP::Menu( _
    item_open, _
    item_saveas, _
    IUP::Separator(), _
    item_exit)
edit_menu = IUP::Menu( _
    item_find, _
    item_goto)
format_menu = IUP::Menu(item_font)
help_menu = IUP::Menu(item_about)
 
sub_menu_file = IUP::Submenu("File", file_menu)
sub_menu_edit = IUP::Submenu("Edit", edit_menu)
sub_menu_format = IUP::Submenu("Format", format_menu)
sub_menu_help = IUP::Submenu("Help", help_menu)
 
menu = IUP::Menu( _
    sub_menu_file, _
    sub_menu_edit, _
    sub_menu_format, _
    sub_menu_help)
 
 
vbox = IUP::Vbox(toolbar_hb, tbox, lbl_statusbar)
 
dlg = IUP::Dialog(vbox)
IUP::SetAttributeHandle(dlg, "MENU", menu)
IUP::SetAttribute(dlg, "TITLE", "Simple Editor")
IUP::SetAttribute(dlg, "SIZE", "QUARTERxQUARTER")
IUP::ShowXY(dlg, IUP_CENTER, IUP_CENTER)
IUP::SetAttribute(dlg, "USERSIZE")
Iup::SetCallback(dlg, "CLOSE_CB", ADDRESS(Win_exit()))
 
IUP::MainLoop
IUP::Close
 

ScriptBasic Blog / Re: ScriptBasic 3.0

« Last post by John on April 21, 2024, 04:39:18 PM »

I was able to get IUP working with ScriptBasic Windows 64 bit. This is an example is using sbw64.exe which has Windows styles support and runs as a true Windows app.

I don't plan on releasing IUP until it's tested on Linux and a direct callback method upgrade is done. I use VB6 + VBCCR to build COM form / class object DLLs that ScriptBasic uses on Windows 32 bit.

Code: ScriptBasic

' IUP Online Dictionary
 
IMPORT iup.bas
 
servers[0]="dict.org"
servers[1]="dict1.us.dict.org"
servers[2]="all.dict.org"
 
about="""This is a Demo
of the IUP GUI Binding
for Scriptbasic"""
 
' Initialize IUP
Iup::Open()
 
' Create main window
 
win = Iup::Create("dialog")
  Iup::SetAttributes(win, "TITLE=\"ScriptBasic IUP Online Dictionary\", SIZE=500x300")
  Iup::SetCallback(win,"CLOSE_CB",ADDRESS(Win_exit()))
 
' Create container to house ALL GUI objects
 
vbox = Iup::Create("vbox")
  Iup::SetAttributes(vbox, "MARGIN=10x10")
 
' Create server panel
 
topBox = Iup::Create("hbox")
  Iup::SetAttributes(topBox, "GAP=10")
  Iup::Append(vbox, topBox)
serverFrame = Iup::Create("frame")
  Iup::SetAttributes(serverFrame, "TITLE=Servers, EXPAND=YES")
  Iup::Append(topBox, serverFrame)
serverBox = Iup::Create("hbox")
  Iup::SetAttributes(serverBox, "GAP=5")
  Iup::Append(serverFrame, serverBox)
serverCombo = Iup::Create("list")
  Iup::SetAttributes(serverCombo, "DROPDOWN=YES, SIZE=120x, EXPAND=HORIZONTAL, VALUE=1")
  Iup::Append(serverBox, serverCombo)
  Iup::SetCallback(serverCombo, "ACTION", ADDRESS(serverCombo_selected()))
btnFetch = Iup::Create("button")
  Iup::SetAttributes(btnFetch, "TITLE=Fetch, SIZE = 50x")
  Iup::Append(serverBox, btnFetch)
  Iup::SetCallback(btnFetch, "ACTION", ADDRESS(btnFetch_clicked()))
 
' Create control panel
 
controlFrame = Iup::Create("frame")
  Iup::SetAttributes(controlFrame, "TITLE=Controls")
  Iup::Append(topBox, controlFrame)
controlBox = Iup::Create("hbox")
  Iup::SetAttributes(controlBox, "GAP=5")
  Iup::Append(controlFrame, controlBox)
btnAbout = Iup::Create("button")
  Iup::SetAttributes(btnAbout, "TITLE=About, SIZE = 50x")
  Iup::Append(controlBox, btnAbout)
  Iup::SetCallback(btnAbout, "ACTION", ADDRESS(btnAbout_clicked()))
btnClear = Iup::Create("button")
  Iup::SetAttributes(btnClear, "TITLE=Clear, SIZE = 50x")
  Iup::Append(controlBox, btnClear)
  Iup::SetCallback(btnClear, "ACTION", ADDRESS(btnClear_clicked()))
btnExit = Iup::Create("button")
  Iup::SetAttributes(btnExit, "TITLE=Exit, SIZE = 50x")
  Iup::Append(controlBox, btnExit)
  Iup::SetCallback(btnExit,"ACTION",ADDRESS(Win_exit()))
 
' Create dictionary panel
 
dictFrame = Iup::Create("frame")
  Iup::SetAttributes(dictFrame, "TITLE=Dictionaries")
  Iup::Append(vbox, dictFrame)
serverList = Iup::Create("list")
  Iup::SetAttributes(serverList, "EXPAND=YES, VISIBLELINES=1")
  Iup::Append(dictFrame, serverList)
  Iup::SetCallback(serverList, "ACTION", ADDRESS(serverList_selected()))
 
' Create text part
 
transFrame = IUP::Create("frame")
  Iup::SetAttributes(transFrame, "TITLE=Translation")
  Iup::Append(vbox, transFrame)
text = Iup::Create("text")
  Iup::SetAttributes(text, "MULTILINE=YES, EXPAND=YES")
  Iup::Append(transFrame, text)
 
' Create entry and search button
 
bottomBox = Iup::Create("hbox")
  Iup::SetAttributes(bottomBox, "GAP=10")
  Iup::Append(vbox, bottomBox)
label = Iup::Create("label")
  Iup::SetAttributes(label, "TITLE=\"Enter Word to Search For:\", SIZE=x12")
  Iup::Append(bottomBox, label)
entry = Iup::Create("text")
  Iup::SetAttributes(entry, "EXPAND=HORIZONTAL")
  Iup::Append(bottomBox, entry)
btnSearch = Iup::Create("button")
  Iup::SetAttributes(btnSearch,"TITLE=Search, SIZE=50x")
  Iup::Append(bottomBox, btnSearch)
  Iup::SetCallback(btnSearch, "ACTION", ADDRESS(btnSearch_clicked()))
chkAll = Iup::Create("toggle")
  Iup::SetAttributes(chkAll, "TITLE=ALL, SIZE=x12")
  Iup::Append(bottomBox, chkAll)
chkUTF = Iup::Create("toggle")
  Iup::SetAttributes(chkUTF, "TITLE=UTF-8, SIZE=x12")
  Iup::Append(bottomBox, chkUTF)
 
' Add the main GUI container to the Window
 
Iup::Append(win, vbox)
 
' Setup dialog defaults
 
Iup::Show(win)
Iup::SetFocus(btnFetch)
FOR i = 0 TO UBOUND(servers)
  Iup::SetAttribute(serverCombo, "APPENDITEM", servers[i])
NEXT
Iup::SetAttribute(serverCombo, "VALUE", "1")
Iup::Update(serverCombo)
server_selection = servers[0]
 
' Main processing loop
 
Iup::MainLoop()
Iup::Close()
END
 
' Callback routines
 
SUB Win_exit
  Iup::ExitLoop = TRUE
END SUB
 
SUB btnAbout_clicked
  Iup::Message("ABOUT", about)
END SUB
 
SUB serverCombo_selected
  server_selection = Iup::GetListText()
END SUB
 
SUB serverList_selected
  whichDictionary = Iup::GetListText()
END SUB
 
SUB btnFetch_clicked
  LOCAL dat, total, count
  ON ERROR GOTO G_NetError
  OPEN server_selection & ":2628" FOR SOCKET AS #1
  PRINT#1,"SHOW DB\n"
  LINE INPUT#1, dat
  LINE INPUT#1, dat
  count = 0
  WHILE LEFT(dat, 1) <> "."
    LINE INPUT#1, dat
    IF LEFT(dat, 1) <> "." THEN total[count] = TRIM(dat)
    count+=1
  WEND
  PRINT#1,"QUIT\n"
  CLOSE(#1)
  FOR cnt = 0 TO count - 2
    Iup::SetAttribute(serverList, "APPENDITEM", total[cnt])
  NEXT
  Iup::SetAttribute(serverList, "VALUE", "1")
  Iup::Update(serverCombo)
  whichDictionary = total[0]
  EXIT SUB
 
  G_NetError:
  PRINT "Server ",server_selection," not available. (",ERROR,")\n"
END SUB
 
SUB btnClear_clicked
  Iup::ClearList(serverList)
  Iup::SetAttribute(text, "VALUE", "")
  Iup::SetAttribute(entry, "VALUE", "")
END SUB
 
SUB btnSearch_clicked
  LOCAL dict, dat, total, info
  IUP::SetAttribute(text, "VALUE","Fetching....")
  ON ERROR GOTO L_NetError
  dict = LEFT(whichDictionary, INSTR(whichDictionary, " "))
  OPEN server_selection & ":2628" FOR SOCKET AS 1
  IF Iup::GetAttribute(chkAll, "VALUE") THEN
    PRINT#1,"DEFINE * " & Iup::GetAttribute(entry,"VALUE") & "\n"
  ELSE
    PRINT#1,"DEFINE " & dict & " " & Iup::GetAttribute(entry,"VALUE") & "\n"
  END IF
  REPEAT
    LINE INPUT#1, dat
    IF LEFT(dat, 3) = "151" THEN
      total$ &= "------------------------------\r\n"
      total$ &= RIGHT(dat, LEN(dat) - LEN(Iup::GetAttribute(entry, "VALUE")) - LEN(dict))
      total$ &= "------------------------------\r\n"
      REPEAT
        LINE INPUT#1, info
        info = REPLACE(info, CHR(34), CHR(92) & CHR(34))
        IF LEFT(info, 1) <> "." THEN total &= TRIM(info) & "\n"
      UNTIL LEFT(info, 1) = "."
      total &= "\n"
    END IF
  UNTIL LEFT(dat, 3) = "250" OR VAL(LEFT(dat, 3)) > 499
  PRINT#1,"QUIT\n"
  CLOSE(#1)
  IF LEFT(dat, 3) = "552" THEN
    total = "No match found."
  ELSE IF LEFT(dat, 3) = "501" THEN
    total = "Select a dictionary first!"
  ELSE IF LEFT(dat, 3) = "550" THEN
    total = "Invalid database!"
  END IF
  Iup::SetAttribute(text, "VALUE", total)
EXIT SUB
 
L_NetError:
  dat[0] = "Could not lookup word! (" & ERROR & ")"
  Iup::SetAttribute(text, "VALUE", dat)
END SUB
 

ScriptBasic Blog / Re: ScriptBasic 3.0

« Last post by John on April 19, 2024, 03:45:00 PM »

If you would like to have both 32 and 64 bit versions of ScriptBasic for Windows installed, this is how I have my system setup.

ScriptBasic by default uses SCRIBA.INI as its compiled configuration file with both 32 and 64 bit versions. If you create a scriba.conf configuration file in your bin directory the SCRIBA.INI isn't needed. The other issue with using the C:\Windows directory is it requires ADMIN privileges to create/change/delete it.

1. Install the 32 bit version and move the SCRIBA.INI (C:\Windows) to your ScriptBasic install bin directory and rename it to scriba.conf. Rename SCRIBA.INI.txt to scriba.conf.txt.

2. Install the 64 bit version and do the same as the previous step. In addition rename the 64 bit sbw.exe version to sbwin.exe so it doesn't conflict with the 32 bit version.

To modify your configuration change directory to your bin and execute this command. This assumes you installed ScriptBasic in the default directories.

32 Bit
sbc -f C:\ScriptBasic\bin\scriba.conf -k scriba.conf.txt

64 Bit
scriba -f C:\ScriptBasic64\bin\scriba.conf -k scriba.conf.txt

The 32 bit version uses xxxx.sbi for IMPORT / INCLUDE files. The 64 bit version uses .bas. Keep that in mind if you're sharing scripts between versions.

ScriptBasic Blog / Re: ScriptBasic 3.0

« Last post by John on April 17, 2024, 09:19:49 PM »

This OxygenBasic example embedding ScriptBasic (libscriab.dll) gets the current weather with the curl extension module and using the LIKE ScriptBasic function to parse the temperature from the JSON response.

weather.o2bas

Code: Text

' O2 SB cURL OpenWeather Example
 
% filename "weather.exe"
includepath "$/inc/"
uses rtl64
include "sbembed.inc"
#console
uses console
 
sys pProgram, fnsn
sbData *arg
sbData *argr
string cr = chr(13,10)
 
pProgram = scriba_new(@newmem, @freemem)
scriba_LoadConfiguration(pProgram, "C:\Windows\SCRIBA.INI")
scriba_SetFileName(pProgram, "weather.sb")
scriba_LoadSourceProgram(pProgram)
scriba_Run(pProgram, "")
 
@arg = scriba_NewSbArgs(pProgram, "s", "Lynden,US")
fnsn = scriba_LookupFunctionByName(pProgram, "main::get_weather")
@argr = scriba_NewSbArgs(pProgram,"s", "")
scriba_CallArgEx(pProgram, fnsn, argr, 1, arg)
string json = argr.str
string mask = `*temp":*,*`
@arg = scriba_NewSbArgs(pProgram, "s s", json, mask)
fnsn = scriba_LookupFunctionByName(pProgram, "main::sb_like")
@argr = scriba_NewSbArgs(pProgram,"i", 0)
scriba_CallArgEx(pProgram, fnsn, argr, 2, arg)
@arg = scriba_NewSbArgs(pProgram, "i", 2)
fnsn = scriba_LookupFunctionByName(pProgram, "main::sb_match")
@argr = scriba_NewSbArgs(pProgram,"s", "")
scriba_CallArgEx(pProgram, fnsn, argr, 1, arg)
print "Lynden WA Temperature is " + argr.str + " F" + cr
 
scriba_DestroySbArgs(pProgram, arg, 2)
scriba_DestroySbArgs(pProgram, argr, 1)
scriba_destroy(pProgram)
 

weather.sb

Code: ScriptBasic

' OpenWeather - Embedded Example
 
IMPORT curl.bas
 
FUNCTION Get_Weather(place)
  ch = curl::init()
  curl::option(ch, "URL", "https://api.openweathermap.org/data/2.5/weather?q=" & place & "&units=imperial&appid=OpenWeather_API-KEY")
  curl::option(ch, "CUSTOMREQUEST", "GET")
  response = curl::perform(ch)
  curl::finish(ch)
  PRINT response,"\n\n"
  Get_Weather = response
END FUNCTION
 
' REPLACE
FUNCTION sb_replace(basestr, searchstr, replacestr, occurances, startpos)
  sb_replace = REPLACE(basestr, searchstr, replacestr, occurances, startpos)
END FUNCTION
 
' LIKE
FUNCTION sb_like(basestr, mask)
  ok = basestr LIKE mask
  sb_like = ok
END FUNCTION
 
' MATCH
FUNCTION sb_match(segment)
  sb_match = JOKER(segment)
END FUNCTION  
 

Output
C:\OxygenBasic\demos\ScriptBasic>weather {"coord":{"lon":-122.4521,"lat":48.9465},"weather":[{"id":800,"main":"Clear","description":"clear sky","icon":"01n"}],"base":"stations","main":{"temp":46.13,"feels_like":46.13,"temp_min":43.59,"temp_max":48.63,"pressure":1028,"humidity":58},"visibility":10000,"wind":{"speed":1.01,"deg":166,"gust":3},"clouds":{"all":0},"dt":1713413156,"sys":{"type":2,"id":2090762,"country":"US","sunrise":1713359602,"sunset":1713409479},"timezone":-25200,"id":5802035,"name":"Lynden","cod":200} Lynden WA Temperature is 46.13 F C:\OxygenBasic\demos\ScriptBasic>

ScriptBasic Blog / Re: ScriptBasic 3.0

« Last post by John on April 16, 2024, 10:16:36 PM »

I found a workaround for the issue. It seems the problem is with assigning with double literals.

Code: Text

double dp = 2.2
scriba_SetVariable(pProgram, v_b, SBT_DOUBLE, 0, dp, "", 0)
 

Output
C:\OxygenBasic\demos\ScriptBasic>getsetvars 1 0.2 Three 101 2.2000000000000002 Thirty Three C:\OxygenBasic\demos\ScriptBasic>

ScriptBasic Blog / Re: ScriptBasic 3.0

« Last post by John on April 16, 2024, 08:44:00 PM »

I tried a different embedding example that was more complex and refined. (o2 embed include) The problem seems to be OxygenBasic setting a double in a structure. Getting a double seems to work.

Using SBT to develop your embedding scripts before using them in your development environment is handy.

Embedding ScriptBasic also gives you access to all the extension modules it supports including COM.

getsetvars.o2bas

Code: Text

% filename "getsetvars.exe"
includepath "$/inc/"
uses rtl64
include "sbembed.inc"
#console
uses console
 
sys pProgram
sbData *arg
string cr = chr(13,10)
 
string src = `IMPORT "testvars.sb"` + cr
 
pProgram = scriba_new(@newmem, @freemem)
scriba_LoadConfiguration(pProgram, "C:\Windows\SCRIBA.INI")
scriba_SetFileName(pProgram, "none")
scriba_LoadProgramString(pProgram, src, len(src))
scriba_Run(pProgram, "")
 
sys v_a = scriba_LookupVariableByName(pProgram, "main::a")
sys v_b = scriba_LookupVariableByName(pProgram, "main::b")
sys v_c = scriba_LookupVariableByName(pProgram, "main::c")
 
' Get defined variable values
 
scriba_GetVariable(pProgram, v_a, @@arg)
print arg.lng + cr
scriba_GetVariable(pProgram, v_b, @@arg)
print arg.dbl + cr
scriba_GetVariable(pProgram, v_c, @@arg)
print arg.str + cr + cr
 
' Set variable values
 
scriba_SetVariable(pProgram, v_a, SBT_LONG, 101, 0.0, "", 0)
scriba_SetVariable(pProgram, v_b, SBT_DOUBLE, 0, 2.2, "", 0)
scriba_SetVariable(pProgram, v_c, SBT_STRING, 0, 0.0, "Thirty Three", 12)
 
' Get changed variable values
 
scriba_GetVariable(pProgram, v_a, @@arg)
print arg.lng + cr
scriba_GetVariable(pProgram, v_b, @@arg)
print arg.dbl + cr
scriba_GetVariable(pProgram, v_c, @@arg)
print arg.str + cr
 
scriba_DestroySbArgs(pProgram, arg, 1)
scriba_destroy(pProgram)
 

sbembed.inc

Code: Text

' ScriptBasic Embedding Include
 
% libScriba = "libScriba.dll"
 
type SbData
  typ as dword
  siz as dword
  union {
    undef as sys
    dbl   as double
    lng   as sys
    str   as char*
    strz  as char*
  }
end type
 
#define SBT_UNDEF  0
#define SBT_DOUBLE 1
#define SBT_LONG   2
#define SBT_STRING 3
#define SBT_ZCHAR  4
 
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
 

testvars.sb

Code: ScriptBasic

a = 1
b = .2
c = "Three"
 

Output
C:\OxygenBasic\demos\ScriptBasic>getsetvars 1 0.2 Three 101 #qNAN Thirty Three C:\OxygenBasic\demos\ScriptBasic>

ScriptBasic Blog / Re: ScriptBasic 3.0

« Last post by John on April 16, 2024, 06:51:04 PM »

I gave the OxygenBasic embedding ScriptBasic libscriba.dll another try with Charles's update of a week ago. It still has the double (vision

) issue.

ScriptBasic Blog / Re: ScriptBasic 3.0

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

I added the ScriptBasic games to the repository.

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.

ScriptBasic Blog / 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
 

Pages: 1 ... 4 5 [6] 7 8 ... 10

AllBASIC Forum / ScriptBasic Blog

News:

Recent Posts

ScriptBasic Blog / Re: ScriptBasic 3.0

ScriptBasic Blog / Re: ScriptBasic 3.0

ScriptBasic Blog / Re: ScriptBasic 3.0

ScriptBasic Blog / Re: ScriptBasic 3.0

ScriptBasic Blog / Re: ScriptBasic 3.0

ScriptBasic Blog / Re: ScriptBasic 3.0

ScriptBasic Blog / Re: ScriptBasic 3.0

ScriptBasic Blog / Re: ScriptBasic 3.0

ScriptBasic Blog / Re: ScriptBasic 3.0

ScriptBasic Blog / Re: ScriptBasic 3.0