'Generated with PluriBASIC 6.0.237326.0 $ filename "C:\Users\Diamante\Documents\PluriBASIC\projects\drmario\drmario.exe" uses rtl32 %NoConsole uses console DIM STRING ¤SYSTEM_UDT_OFFSETS(0) ' dimension offsets. #DEF ¤DIM1 (d1-bnd[1]) #DEF ¤DIM2 (d2-bnd[3]) #DEF ¤DIM3 (d3-bnd[5]) ' dimension sizes (in elements) #DEF ¤DSZ1 dsz[1] #DEF ¤DSZ2 dsz[2] #DEF ¤DSZ3 dsz[3] #DEF ¤ARR_NAME_DEF class ¤ARR_%1 STRING ¤TMPS = "" ' a temporary string. DECLARE FUNCTION ¤GetLastError Lib "Kernel32.dll" Alias "GetLastError" () AS LONG DECLARE FUNCTION ¤GetAsyncKeyState Lib "User32.dll" Alias "GetAsyncKeyState" (ByVal vKey AS LONG) AS short DECLARE SUB ¤Sleep lib "Kernel32.dll" alias "Sleep" (dword mSec) function ¤INI_QUAD(dword v1, v2) as quad quad v = 0 copy(@v+0, @v2, 4) copy(@v+4, @v1, 4) return v end function DECLARE FUNCTION ¤OpenProcess Lib "KERNEL32.DLL" Alias "OpenProcess" (ByVal dwDesiredAccess AS DWORD, ByVal bInheritHandle AS LONG, ByVal dwProcessId AS SYS) AS SYS DECLARE FUNCTION ¤TerminateProcess Lib "KERNEL32.DLL" Alias "TerminateProcess" ( ByVal hProcess AS SYS, ByVal uExitCode AS DWORD) AS LONG DECLARE FUNCTION ¤CloseHandle Lib "KERNEL32.DLL" Alias "CloseHandle" (ByVal hObject AS SYS) AS LONG DECLARE FUNCTION ¤GetCurrentProcessId Lib "KERNEL32.DLL" Alias "GetCurrentProcessId" () AS SYS MACRO ¤SET_ERR(n) Err.err = n Err.erl = Err.erp END MACRO MACRO ¤ONERR(l, e) Err.err = e IF (Err.err>0) THEN Err.ers = Err.erp Err.erl = l IF Err.Oe1 THEN JMP Err.Oe1 ELSEIF Err.Oe2 THEN CALL Err.Oe2 END IF else Err.ers = "" Err.erl = 0 END IF END MACRO MACRO ERRCLEAR Err.err = 0 Err.erl = 0 Err.ers = "" END MACRO CLASS ¤SYSERR public sys Oe1 = 0 public sys Oe2 = 0 public int err = 0 public int erl = 0 public string erp = "" public string ers = "" END CLASS TYPE ¤RECT long left long top long right long bottom END TYPE DECLARE FUNCTION ¤GetParent LIB "USER32.DLL" ALIAS "GetParent" (BYVAL hWnd AS SYS) AS SYS DECLARE FUNCTION ¤GetDC LIB "USER32.DLL" ALIAS "GetDC" (BYVAL hWnd AS SYS) AS SYS DECLARE function ¤GetStockObject lib "GDI32.DLL" alias "GetStockObject" DECLARE function ¤GetSystemMetrics lib "USER32.DLL" ALIAS "GetSystemMetrics"(byval nIndex int) as int DECLARE function ¤GetDeviceCaps lib "GDI32.DLL" alias "GetDeviceCaps" (byval hdc as sys, byval nIndex as int) as int DECLARE function ¤ReleaseDC lib "USER32.DLL" alias "ReleaseDC" (byval hWnd as sys, byval hDC as sys) as INT Declare Function ¤CreateWindowEx Lib "user32.dll" Alias "CreateWindowExA" (byval dwExStyle AS INT,byval lpClassName AS STRING,byval lpWindowName AS STRING,byval dwStyle AS INT,byval x AS INT,byval y AS INT,byval nWidth AS INT,byval nHeight AS INT,byval hWndParent AS INT,byval hMenu AS INT,byval hInstance AS INT,byval lpParam AS INT) as INT Declare Function ¤CreateSolidBrush Lib "gdi32.dll" Alias "CreateSolidBrush"(ByVal crColor As INT) As INT Declare Function ¤GetSysColor Lib "user32.dll" Alias "GetSysColor" (ByVal nIndex As INT) As INT Declare Function ¤LoadIcon Lib "user32.dll" Alias "LoadIconA" (ByVal hInstance As INT, ByVal lpIconName As Any) As INT Declare Function ¤LoadCursor Lib "user32.dll" Alias "LoadCursorA" (ByVal hInstance As INT, ByVal lpCursorName As Any) As INT Declare Function ¤GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleA" (int lpModuleName) as SYS Declare Function ¤GetWindowRect Lib "user32.dll" Alias "GetWindowRect" (BYVAL hWnd AS sys, lpRect AS ¤RECT) AS INT Declare Function ¤CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (byval hProc as sys, ByVal hWnd As INT, ByVal wMsg As INT, ByVal wParam As INT, ByVal lParam As INT) As INT Declare Function ¤DefWindowProc Lib "user32.dll" Alias "DefWindowProcA" (ByVal hWnd As INT, ByVal wMsg As INT, ByVal wParam As INT, ByVal lParam As INT) As INT Declare Function ¤DefWindowProcCallBack Lib "user32.dll" Alias "DefWindowProcA" (ByVal hWnd As INT, ByVal wMsg As INT, ByVal wParam As INT, ByVal lParam As INT) As INT Declare Function ¤GetSysColor Lib "user32.dll" Alias "GetSysColor" (ByVal nIndex As INT) As INT Declare Function ¤GetDialogBaseUnits LIB "User32.dll" ALIAS "GetDialogBaseUnits" () AS INT Declare Function ¤MulDiv LIB "KERNEL32.DLL" ALIAS "MulDiv" (BYVAL nNumber AS INT, BYVAL nNumerator AS INT, BYVAL nDenominator AS INT) AS INT Declare Function ¤MapDialogRect LIB "user32.DLL" ALIAS "MapDialogRect" (ByVal hWnd As SYS, Byref RC AS ¤RECT) AS SYS Declare Function ¤GetDesktopWindow LIB "user32.DLL" ALIAS "GetDesktopWindow" () AS SYS Declare Function ¤GetLastError LIB "Kernel32.DLL" ALIAS "GetLastError" () AS SYS Declare Function ¤FormatMessage LIB "Kernel32.dll" ALIAS "FormatMessageA" (BYVAL dwFlags AS DWORD, BYVAL lpSource AS DWORD, BYVAL dwMessageId AS DWORD, BYVAL dwLanguageId AS DWORD, lpBuffer AS ASCIIZ, BYVAL nSize AS DWORD, BYVAL Arguments AS DWORD) AS DWORD DECLARE FUNCTION ¤CreateDialogIParam LIB "user32.dll" ALIAS "CreateDialogIndirectParamA" (sys hInstance, lpTemplate, hWndParent, lpDialogFunc, lParamInit) as sys DECLARE SUB ¤PostQuitMessage LIB "User32.dll" ALIAS "PostQuitMessage" DECLARE SUB ¤DestroyWindow LIB "User32.dll" ALIAS "DestroyWindow" DECLARE FUNCTION ¤GetDlgItem LIB "User32.dll" ALIAS "GetDlgItem" (BYVAL hDlg AS SYS, BYVAL nIDDlgItem AS sys) AS SYS DECLARE FUNCTION ¤RedrawWindow LIB "User32.dll" ALIAS "RedrawWindow" DECLARE FUNCTION ¤SetProp Lib "user32.dll" Alias "SetPropA" (ByVal hWnd As SYS, BYVAL lpString As DWORD, BYVAL hAddr AS DWORD) AS SYS DECLARE FUNCTION ¤GetProp Lib "user32.dll" Alias "GetPropA" (ByVal hWnd As SYS, BYVAL lpString As DWORD) AS SYS DECLARE FUNCTION ¤SetWindowText Lib "user32.dll" Alias "SetWindowTextA" (ByVal hWnd As SYS, BYVAL lpString As DWORD) AS SYS DECLARE FUNCTION ¤RemoveProp Lib "user32.dll" Alias "RemovePropA" (ByVal hWnd As SYS, BYVAL lpString As DWORD) AS SYS DECLARE FUNCTION ¤SetWindowPos LIB "User32.dll" ALIAS "SetWindowPos" (BYVAL hWnd AS SYS, BYVAL hWndInsertAfter AS DWORD, BYVAL x AS INT, BYVAL y AS INT, BYVAL cx AS INT, BYVAL cy AS INT, BYVAL wFlags AS DWORD) AS INT DECLARE FUNCTION ¤GetWindowTextLength LIB "User32.dll" ALIAS "GetWindowTextLengthA" (BYVAL hWnd AS SYS) AS INT DECLARE FUNCTION ¤GetWindowText LIB "User32.dll" ALIAS "GetWindowTextA" (BYVAL hWnd AS SYS, BYVAL lpString AS DWORD, BYVAL cch AS INT) AS INT 'DECLARE FUNCTION ¤GetProcessHeap Lib "kernel32.dll" Alias "GetProcessHeap" () As SYS 'DECLARE FUNCTION ¤HeapAlloc Lib "kernel32.dll" Alias "HeapAlloc" (ByVal hProc As DWORD, ByVal mMode As dword, byval mSize as DWORD) AS SYS 'DECLARE FUNCTION ¤HeapFree Lib "kernel32.dll" Alias "HeapFree" (ByVal hProc As DWORD, ByVal mMode As dword, byval hObj as DWORD) AS SYS TYPE ¤DLGTEMPLATE dword style dword eStyle word cdit short x short y short cx short cy END TYPE ¤RECT ¤RC CHAR ¤DTT[6] = "DATA" + chr(0) sys ¤LPPI = 0 SYS ¤HPPA = 0 ¤DLGTEMPLATE ¤LPDT ¤LPDT.style = 2155872320 ¤LPDT.eStyle = 1 ¤LPDT.cdit = 0 ¤LPDT.x = 1 ¤LPDT.y = 1 ¤LPDT.cx = 2 ¤LPDT.cy = 2 ' Create a dummy dialog to retrieve dialog units. sys ¤TODL = ¤CreateDialogIParam(¤GetModuleHandle(0), @¤LPDT, ¤HPPA, @¤DEFAULT_CALLBACK_PROC, ¤LPPI) ¤RC.right = 1 ¤RC.bottom = 1 ¤MapDialogRect(¤TODL, ¤RC) TYPE ¤WNDCLASSEX ' 32 bit headers for use with DIALOG NEW cbSize as int Style as int lpfnwndproc as sys cbClsextra as int cbWndExtra as int hInstance as int hIcon as int hCursor as int hbrBackground as int lpszMenuName as int lpszClassName as int hIconSm AS int END TYPE Declare Function ¤RegisterClassEx Lib "user32.dll" Alias "RegisterClassExA" (byref lpwcx as ¤WNDCLASSEX) as INT ¤WNDCLASSEX ¤WClass ¤WClass.cbSize = SizeOf(¤WNDCLASSEX) ¤WClass.style = 40 ¤WClass.lpfnWndProc = &¤DefWindowProcCallBack ¤WClass.hInstance = ¤GetModuleHandle(0) ¤WClass.hIcon = ¤LoadIcon(0, ByVal 32512) 'loads an icon for use by the program ¤WClass.hCursor = ¤LoadCursor(0, ByVal 32512) 'loads a mouse cursor for use by the program ¤WClass.hbrBackground = ¤CreateSolidBrush(¤GetSysColor(15)) ¤WClass.lpszMenuName = STRPTR("") ¤WClass.lpszClassName = STRPTR("DDTDialog") ¤WClass.hIConSm = ¤LoadIcon(0, ByVal 32512) 'loads an icon for use by the program Call ¤RegisterClassEx(¤WClass) 'registers a window class for the program window 'print ¤RC.right " - " ¤RC.bottom TYPE ¤MSG hwnd as int message as int wParam as int lParam as int time as dword 'part of pointapi. X as INT Y as INT END TYPE Declare Function ¤ShowWindow Lib "user32.dll" Alias "ShowWindow" (ByVal hWnd As INT, ByVal nCmdShow As INT) As INT Declare Function ¤TranslateMessage Lib "user32.dll" Alias "TranslateMessage" (byref lpMsg as ¤MSG) as INT Declare Function ¤DispatchMessage Lib "user32.dll" Alias "DispatchMessageA" (byref lpMsg as ¤MSG) as INT Declare Function ¤GetMessage Lib "user32.dll" Alias "GetMessageA" (lpMsg As ¤MSG, ByVal hWnd As INT, ByVal wMsgFilterMin As INT, ByVal wMsgFilterMax As INT) As INT DECLARE FUNCTION ¤IsWindow LIB "USER32.DLL" ALIAS "IsWindow" (BYVAL hWnd AS DWORD) AS int DECLARE FUNCTION ¤SetWindowLong LIB "USER32.DLL" ALIAS "SetWindowLongA" (BYVAL hWnd AS DWORD, BYVAL nIndex AS INT, BYVAL lNewLong AS QUAD) AS INT DECLARE FUNCTION ¤SendMessage LIB "USER32.DLL" ALIAS "SendMessageA" (BYVAL hWnd AS DWORD, BYVAL dwMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS INT) AS INT DECLARE FUNCTION ¤SetWindowLong LIB "USER32.DLL" ALIAS "SetWindowLongA" (BYVAL hWnd AS DWORD, BYVAL nIndex AS INT, BYVAL lNewLong AS INT) AS INT DECLARE FUNCTION ¤GetWindowLong LIB "USER32.DLL" ALIAS "GetWindowLongA" (BYVAL hWnd AS DWORD, BYVAL nIndex AS INT) AS INT declare function PluriBASICGetTickCntTimer lib "kernel32.dll" alias "GetTickCount" () as dword declare function ¤srand lib "msvcrt.dll" alias "srand" (int seed) declare function ¤rand lib "msvcrt.dll" alias "rand" () as INT declare function ¤GetTickCount lib "kernel32.dll" alias "GetTickCount" () as dword DOUBLE ¤LRNGN = 0 INT ¤LRNLB = 0 INT ¤LRNUB = 0 TYPE ¤HPROP long elem long dmode sys oldProc sys curProc 'long user1 'long user2 END TYPE Function ¤DEFAULT_CALLBACK_PROC(sys hwnd, wMsg, wParam, lParam) as sys callback sys retval = 0 ¤HPROP *hdata ¤HPROP *hdat2 sys hWnd2 = 0 @hData = ¤GetProp(hwnd, byval @¤DTT) If @hData Then if hData.curProc then if hData.elem = 2 then Select case wMsg case 273, 78 sys hControl = ¤GetDlgItem(hwnd, loword(wParam)) @hdat2 = ¤GetProp(hControl, byval @¤DTT) if @hDat2 then if hDat2.curProc then retval = ¤CallWindowProc(hDat2.curProc, hWnd, wMsg, wParam, lParam) goto DoneWithNotifications end if end if end select end if retval = ¤CallWindowProc(hData.curProc, hWnd, wMsg, wParam, lParam) DoneWithNotifications: end if end if if retval=0 then if @hData then if hData.elem = 2 then IF hData.curProc=0 then hWnd2 = ¤GetParent(hWnd) @hdat2 = ¤GetProp(hWnd2, byval @¤DTT) if @hdat2 then if hdat2.curProc then retval = ¤CallWindowProc(hDat2.curProc, hWnd, wMsg, wParam, lParam) end if END IF END IF if retval=0 then retval = ¤CallWindowProc(hData.oldProc, hWnd, wMsg, wParam, lParam) end if else retval = ¤DefWindowProc(hwnd,wMsg,wParam,lParam) end if if wMsg=2 then ' WM_DESTROY If hData.oldProc then ¤SetWindowLong(hWnd, -4, hData.oldProc) end if freememory(@hData) ¤RemoveProp(hWnd, byval @¤DTT) end if else retval = ¤DefWindowProc(hwnd, wMsg, wParam, lParam) end if end if return retval End Function ' STARTS PLURIBASIC_PREPARE.BIN ' This code is executed before anything else, if you want to do something after defining other things, see PLURIBASIC_INIT int ¤i = 0 ' STARTS SYSTEM_OPERATORS.BIN FUNCTION ¤BytOvf(byte b) AS byte return b END FUNCTION FUNCTION ¤NOT(byval quad v1) AS QUAD dword w1 dword w2 quad r copy @w1, @v1, 4 copy @w2, @v1+4, 4 w1 = not(w1) w2 = not(w2) copy @r, @w1, 4 copy @r+4, @w2, 4 return r END FUNCTION FUNCTION ¤AND(byval quad v1, v2) as quad dword w1 dword w2 quad r copy @w1, @v1, 4 copy @w2, @v2, 4 w1 = (w1 and w2) copy @r, @w1, 4 copy @w1, @v1+4, 4 copy @w2, @v2+4, 4 w1 = (w1 and w2) copy @r+4, @w1, 4 return r end function FUNCTION ¤OR(byval int v1, v2) as int return v1 or v2 end function 'FUNCTION ¤OR(byval quad v1, v2) as quad ' dword w1 ' dword w2 ' quad r ' copy @w1, @v1, 4 ' copy @w2, @v2, 4 ' w1 = (w1 or w2) ' copy @r, @w1, 4 ' copy @w1, @v1+4, 4 ' copy @w2, @v2+4, 4 ' w1 = (w1 or w2) ' copy @r+4, @w1, 4 ' return r 'end function FUNCTION ¤IMP(byval quad v1, v2) as quad if v1 then return -1 if v2 then return -1 end function FUNCTION ¤EQV(byval quad v1, v2) as quad if v1=0 then return 0 if v2=0 then return 0 return -1 end function FUNCTION ¤MOD(quad v1, v2) as quad return MOD(v1, v2) end function ' END OF SYSTEM_OPERATORS.BIN ' CONTINUES (17) PLURIBASIC_PREPARE.BIN #DEF HANDLE SYS ' Tested, OK. MACRO ¤UDT_RESET(s, u) copy(u, news(s), s) END MACRO ' Tested, OK. MACRO ¤UDT_COPY(s, u, n) copy(u, n, s) END MACRO ' Tested, OK. macro ¤UDT_SETV(vu, ai, of, dt, nv, ln a, c) sys a = vu.hBuffer + (ai + of) dt c = nv copy(a, @c, ln) end macro ' Tested, OK. macro ¤UDT_SETA(vu, ai, of, nv, ln a, c) sys a = ai + of string c = left(nv, ln) c = (c + news(ln-len(c))) copy(a, strptr(c), ln) end macro 'Tested, OK. macro ¤UDT_SETW(vu, ai, of, nv, ln a, c) sys a = ai + of wstring c = left(nv, ln) c = (c + news(ln-len(c))) copy(a, strptr(c), ln*2) end macro ' Tested, OK. macro ¤MEM_SETV(vu, of, dt, nv, ln c) dt c = nv copy((@vu + of), @c, ln) end macro ' Tested, OK. macro ¤MEM_MODV(vu, of, dt, op, nv, ln c, e) dt e copy(@e, (@vu + of), ln) dt c = e op nv copy((@vu + of), @c, ln) end macro ' Tested, OK. macro ¤MEM_SUBV(vu, of, dt, nv, ln c, e) dt e copy(@e, @vu + of, ln) dt c = e - nv copy(@vu + of, @c, ln) end macro ' Tested, OK. macro ¤MEM_SETA(vu, of, nv, ln c) string c = left(nv, ln) c = (c + news(ln-len(c))) copy(@vu + of, strptr(c), ln) end macro ' Tested, OK. macro ¤MEM_SETW(vu, of, nv, ln c) wstring c = left(nv, ln) c = (c + news(ln-len(c))) copy(@vu + of, strptr(c), ln*2) end macro ' Tested, OK. macro ¤UDT_INCR(vu, ai, of, dt, nv a, c) sys a = (vu.hBuffer + ai + of) dt c = 0 copy(@c, a, sizeof(c)) c = (c + nv) copy(a, @c, sizeof(c)) end macro ' Tested, OK. macro ¤UDT_DECR(vu, ai, of, dt, nv a, c) sys a = (vu.hBuffer + ai + of) dt c = 0 copy(@c, a, sizeof(c)) c = (c - nv) copy(a, @c, sizeof(c)) end macro ' Tested, OK. macro ¤MEM_INCR(vu, of, dt, nv a) dt a = 0 copy(@a, (@vu + of), sizeof(a)) a = (a + nv) copy((@vu + of), @a, sizeof(a)) end macro ' Tested, OK. macro ¤MEM_DECR(vu, of, dt, nv a) dt a = 0 copy(@a, @vu + of, sizeof(a)) a = (a - nv) copy((@vu + of), @a, sizeof(a)) end macro ' Tested, OK. macro ¤SDT_VAL(nm, dt) function nm(sys hBuffer, of) as dt sys a = hBuffer + of dt r copy(@r, a, sizeof(dt)) return r end function end macro function ¤TRIMNUL(string bb) as string byte c at strptr(bb) int i = 0 for i = 1 to len(bb) if c[i] = 0 then return left(bb, i-1) end if next i return bb end function macro ¤SDT_STR(nm) function nm(sys hBuffer, offset, byval int ln) as string sys addr = (hBuffer + offset) if ln = 0 then ln = 255 string bb = space(ln+1) copy(strptr(bb), addr, ln) return ¤TRIMNUL(bb) end function end macro macro ¤SDT_WST(nm) function nm(sys hBuffer, of, byval int ln) as wstring sys addr = (hBuffer + of) if ln = 0 then ln = 255 wstring bb = news(ln) copy(strptr(bb), addr, ln*2) return bb end function end macro TYPE ¤SYSNMHDR hwndFrom AS SYS idFrom AS SYS Code AS DWORD END TYPE class ¤SYSF ' Default UDT member bounds... function m(int d1) as long {return d1} function m(int d1, d2) as long {return (d1 * d2)} function m(int d1, d2, d3) as long {return ((d1 * d2) + d3)} ' Custom UDT member bounds... ' Some ddt functions. function nmcode(sys cbMsg, byval lParam) as long if cbMsg = 78 then ¤SYSNMHDR nh at lParam return nh.code end if end function function nmhwnd(sys cbMsg, lParam) as long if cbMsg = 78 then ¤SYSNMHDR nh at lParam return nh.hwndFrom end if end function function nmid(sys cbMsg, lParam) as long if cbMsg = 78 then ¤SYSNMHDR nh at lParam return nh.idFrom end if end function function nmhdr(sys cbMsg, lParam) as sys if cbMsg = 78 then return lparam end if end function function nmhdrs(sys cbMsg, lParam) as string if cbMsg = 78 then string bs = news(12) copy(strptr(bs), lparam, 12) return bs end if end function function nm(sys cbMsg, lParam) as sys ' WITHOUT THIS, THE EXE IS CORRUPTED. end function ' UDT member readers. ¤SDT_VAL(byt, byte) ¤SDT_VAL(wrd, word) ¤SDT_VAL(int, int) ¤SDT_VAL(lng, long) ¤SDT_VAL(sys, sys) ¤SDT_VAL(dwd, dword) ¤SDT_VAL(qud, quad) ¤SDT_VAL(ext, extended) ¤SDT_VAL(cur, extended) ¤SDT_VAL(cux, extended) ¤SDT_VAL(sng, single) ¤SDT_VAL(dbl, double) ¤SDT_STR(asz) ¤SDT_STR(chr) ¤SDT_STR(str) ¤SDT_WST(wsz) FUNCTION CONSTRUCTOR() END FUNCTION END CLASS new ¤SYSF EXE() def true -1 ' END OF PLURIBASIC_PREPARE.BIN ' STARTS ARRAY_DIM_UDT.BIN ' STARTS VARIANT_INIT.BIN ' END OF VARIANT_INIT.BIN ' CONTINUES (2) ARRAY_DIM_UDT.BIN macro ¤URFN(nm, dt) function nm(int addr, of) as dt sys a = hBuffer + (addr + of) dt r copy @r, a, sizeof(r) return r end function end macro macro ¤URFL(nm, dt) function nm(int addr, of) as dt* sys a = hBuffer + addr + of return a end function end macro macro ¤URFS(nm) function nm(sys addr, of, ln) as string sys a = hBuffer + addr + of string bb = news(ln) copy strptr(bb), a, ln return bb end function end macro macro ¤URFW(nm) function nm(sys addr, of, ln) as wstring sys a = hBuffer + addr + of wstring bb = news(ln) copy strptr(bb), a, ln*2 return bb end function end macro macro ¤URFT(nm) function nm(sys addr, of) as sys sys a = addr + of return a end function function nm(sys of) as sys sys a = this.hBuffer + of return a end function end macro ' Class for User-defined types. macro ¤TYPE_UDT_UDT(dtype) ¤ARR_NAME_DEF(dtype) public dtype t ' for use with typeof on this array. int dims ' Number of dimensions int elems ' Number of elements. int elemsize ' Number of elements. int slength ' length of strings. int ispointer ' is pointer flag. sys hBuffer ' Address of the buffer sys hCustAddr ' Address provided by the inline code. int BuffLen ' length of the buffer in bytes string dtType ' Data type for the array. int iType ' Data type ID for the array. int elemsize ' Data type size. int dimensioned' -1 if dimensioned. int bnd[10] ' bounds. int dsz[10] ' dimension size. public sys h function redim(int pr, int * d, n) int i dimensioned = -1 int ne = 1 int dn = 1 for i = 1 to n step 2 bnd[i+0] = d[i+0] bnd[i+1] = d[i+1] ne *= ((d[i+1]+1)-d[i+0]) dsz[dn] = (d[i+1]-d[i+0])+1 dn += 1 next elems = ne int nBufLen nBufLen = (elems * elemsize) sys nBuffer = getmemory(nBufLen + elemsize) int eBfCopy = BuffLen if BuffLen then if BuffLen>nBufLen then eBfCopy = nBufLen end if copy nBuffer, hBuffer, eBfCopy freememory hBuffer end if hBuffer = nBuffer BuffLen = nBufLen h = hBuffer end function method constructor(int s, int * d, n, isptr, slen, string dtyp, int dtID, int dtSize, sys hAddr) if s then if this.dims then return -1 end if ispointer = isptr dtType = dtyp slength = slen hCustAddr = hAddr iType = dtID elemsize = dtSize dims = n / 2 if n > -1 then this.redim(0, d, n) end if end method function destructor() freememory(hBuffer) hBuffer = 0 BuffLen = 0 end function function b() as string return "" end function '====================================================================== function m(int d1) as long return (¤DIM1 * elemsize) end function function m(int d1, d2) as long return ((¤DSZ1 * ¤DIM2) * elemsize) + (¤DIM1 * elemsize) end function function m(int d1, d2, d3) as long return ((¤DSZ2 * ¤DIM3) * elemsize) + ((¤DSZ1 * ¤DIM2) * elemsize) + (¤DIM1 * elemsize) end function '====================================================================== ' function s(int d1, dtype * v) ' sys r = (hBuffer + this.m(d1)) ' copy r, @v, sizeof(dtype) ' end function function c(int d1) as dtype* sys r = (hBuffer + this.m(d1)) return r end function ' function s(int d1, d2, dtype * v) ' sys r = (hBuffer + this.m(d1, d2)) ' copy r, @v, sizeof(dtype) ' end function function c(int d1, d2) as dtype* sys r = (hBuffer + this.m(d1, d2)) return r end function ' function s(int d1, d2, d3, dtype * v) ' sys r = (hBuffer + this.m(d1, d2, d3)) ' copy r, @v, sizeof(dtype) ' end function function c(int d1, d2, d3) as dtype* sys r = (hBuffer + this.m(d1, d2, d3)) return r end function '====================================================================== function p(int d1) as sys sys r = (hBuffer + this.m(d1)) return r end function function p(int d1, d2) as sys sys r = (hBuffer + this.m(d1, d2)) return r end function function p(int d1, d2, d3) as sys sys r = (hBuffer + this.m(d1, d2, d3)) return r end function function ptr(int d1, of) as sys sys a = (hBuffer + d1) + of return a end function '======================================all different data types. ¤URFN(byt, byte) ¤URFN(wrd, word) ¤URFN(int, int) ¤URFN(lng, long) ¤URFN(dwd, dword) ¤URFN(qud, quad) ¤URFN(ext, extended) ¤URFN(cur, extended) ¤URFN(cux, extended) ¤URFN(sng, single) ¤URFN(dbl, double) ¤URFS(asz) ¤URFS(str) ¤URFW(wst) ¤URFT(udt) '======================================all different data types. function lbound(int d) as int return bnd[(d*2)-1] end function function ubound(int d) as int return bnd[d*2] end function method reset() ' everything. ' missing code! end method method reset(int n) ' specific element. ' missing code! end method function arrayattr(int d) as int // not yet implemented. if d = 0 then return dimensioned if d = 1 then return iType if d = 2 then return ispointer if d = 3 then return dims if d = 4 then return elems if d = 5 then return elemsize return 0 end function end class end macro ' END OF ARRAY_DIM_UDT.BIN ' STARTS ARRAY_DIM_NUM.BIN ' class for numeric arrays. macro ¤TYPE_NUM_UDT(dtype) ¤ARR_NAME_DEF(dtype) public dtype t ' for use with typeof on this array. int dims ' Number of dimensions int elems ' Number of elements. int elemsize ' Number of elements. int slength ' length of strings. int ispointer ' is pointer flag. sys hBuffer ' Address of the buffer sys hCustAddr ' Address provided by the inline code. int BuffLen ' length of the buffer in bytes string dtType ' Data type for the array. int iType ' Data type ID for the array. int elemsize ' Data type size. int dimensioned' -1 if dimensioned. int bnd[10] ' bounds. int wcode function redim(int pr, int * d, n) int i dimensioned = -1 int ne = 1 for i = 1 to n step 2 bnd[i+0] = d[i+0] bnd[i+1] = d[i+1] ne *= ((d[i+1]+1)-d[i+0]) next if ne < elems then if dtType = "STR" then if hBuffer then dtype dt at hBuffer for i = ne+1 to elems frees dt(i) next end if end if end if elems = ne int nBufLen nBufLen = (elems * sizeof(sys)) + 32 sys nBuffer = getmemory(nBufLen) int eBfCopy = BuffLen if BuffLen if BuffLen>nBufLen then eBfCopy = nBufLen end if copy nBuffer, hBuffer, eBfCopy freememory hBuffer endif hBuffer = nBuffer BuffLen = nBufLen end function method constructor(int s, int * d, n, isptr, slen, string dtyp, int dtID, int dtSize, sys hAddr) if s then if this.dims then return -1 end if ispointer = isptr dtType = dtyp slength = slen hCustAddr = hAddr iType = dtID elemsize = dtSize dims = n / 2 if n > -1 then this.redim(0, d, n) end if end method function destructor() int i dtype dt at hBuffer for i = 0 to elems frees dt(i) next dtype dt at hBuffer for i = 0 to elems frees dt(i) next freememory(hBuffer) hBuffer = 0 BuffLen = 0 end function function b() as string return "" end function '====================================================================== function s(int d1, dtype v) dtype dt at hBuffer dt(¤DIM1) = v end function function c(int d1) as dtype dtype dt at hBuffer return dt(¤DIM1) end function function s(int d1, d2, dtype v) dtype dt at hBuffer dt(¤DIM1 * ¤DIM2) = v end function function c(int d1, int d2) as dtype dtype dt at hBuffer return dt(¤DIM1 * ¤DIM2) end function function s(int d1, d2, d3, dtype v) dtype dt at hBuffer dt(¤DIM1 * ¤DIM2 + ¤DIM3) = v end function function c(int d1, d2, d3) as dtype dtype dt at hBuffer return dt(¤DIM1 * ¤DIM2 + ¤DIM3) end function '====================================================================== function p(int d1) as dtype* dtype dt at hBuffer return @dt(¤DIM1) end function function p(int d1, d2) as dtype* dtype dt at hBuffer return @dt(¤DIM1 * ¤DIM2) end function function p(int d1, d2, d3) as dtype* dtype dt at hBuffer return @dt(¤DIM1 * ¤DIM2 + ¤DIM3) end function '====================================================================== function strptr(int d1) as sys dtype dt at hBuffer int i = ¤DIM1 return strptr(dt(i)) end function function strptr(int d1, d2) as sys dtype dt at hBuffer int i = ¤DIM1 * ¤DIM2 return strptr(dt(i)) end function function strptr(int d1, d2, d3) as sys dtype dt at hBuffer int i = ¤DIM1 * ¤DIM2 + ¤DIM3 return strptr(dt(i)) end function '====================================================================== function lbound(int d) as int return bnd[d] end function function ubound(int d) as int return bnd[d+1] end function method reset() ' everything. ' missing code! end method method reset(int n) ' specific element. ' missing code! end method function arrayattr(int d) as int // not yet implemented. if d = 0 then return dimensioned if d = 1 then return iType if d = 2 then return ispointer if d = 3 then return dims if d = 4 then return elems if d = 5 then return elemsize return 0 end function end class end macro ' END OF ARRAY_DIM_NUM.BIN ' STARTS WSTRINGZ.BIN //assigns a truncated null terminated string. MACRO ¤WSTZ_SET(v, c, l b) if l<1 then copy00(@v, chr(0), 1) else wbstring b = left(c, l-1) copy00(@v, b, len(b)) frees b end if END MACRO ' END OF WSTRINGZ.BIN ' STARTS WSTRING.BIN //assigns a truncated null terminated string. MACRO ¤WSTR_SET(v, c, l b) wstring b = c if len(b) > l then b = left(b, l) elseif len(b) < l then b += space(l-len(b)) end if v = b END MACRO ' END OF WSTRING.BIN ' STARTS UDT_ASSIGNER.BIN // copies binary data into a UDT MACRO UDT_ASSIGNER(src, trg buf, i) string buf int i = sizeof(src) buf = trg if i > len(buf) then i = len(buf) copy @src, strptr(buf), i END MACRO ' END OF UDT_ASSIGNER.BIN ' STARTS TIMER.BIN // returns the number of seconds since midnight. FUNCTION TIMER() AS DOUBLE return (PluriBASICGetTickCntTimer() / 1000) END FUNCTION ' END OF TIMER.BIN ' STARTS STRINGN.BIN //Assigns a truncated null terminated string. MACRO ¤STRN_SET(v, c, l b) string b = c if len(b) > l then b = left(b, l) elseif len(b) < l then b += space(l-len(b)) end if v = b END MACRO ' END OF STRINGN.BIN ' STARTS SLEEP.BIN SUB SLEEP(dword mSec) ¤Sleep(mSec) END SUB ' END OF SLEEP.BIN ' STARTS RND.BIN FUNCTION RND() AS DOUBLE ¤LRNGN = (¤rand() / 32767) return ¤LRNGN END FUNCTION FUNCTION RND(int l1) AS DOUBLE double rv = 0 if l1 = 0 then return ¤LRNGN elseif l1 < 0 then int s = ¤GetTickCount() ¤srand(s) rv = (¤rand() / 32767) ¤LRNGN = floor((rv * (¤LRNUB - ¤LRNLB)) + ¤LRNLB) return ¤LRNGN else rv = (¤rand() / 32767) ¤LRNGN = floor((rv * (¤LRNUB - ¤LRNLB)) + ¤LRNLB) return ¤LRNGN end if END FUNCTION FUNCTION RND(byval int l1, l2) AS LONG if l1 > l2 then int l3 = l1 l1 = l2 l2 = l3 end if ¤LRNLB = l1 ¤LRNUB = l2 double rv = (¤rand() / 32767) ¤LRNGN = floor(l1 + (rv * ((l2+1) - l1))) return ¤LRNGN END FUNCTION ' END OF RND.BIN ' STARTS REPEAT$.BIN ' Returns given string repeated n times. FUNCTION REPEAT(int n, string s) AS STRING int i string o for i = 1 to n o += s next i return o END FUNCTION ' END OF REPEAT$.BIN ' STARTS RANDOMIZE.BIN // Seeds the randomizer engine. SUB RANDOMIZE(double seed) int s = floor(seed * 1000) ¤srand(s) ¤rand() END SUB ' END OF RANDOMIZE.BIN ' STARTS PLURIBASIC_INIT.BIN ' This code is executed before anything else, if you want to do something before nything else, see PLURIBASIC_PREPARE ' END OF PLURIBASIC_INIT.BIN ' STARTS MID$.BIN // returns or assigns part of a string. FUNCTION ¤MID(byref string inp, long p, byval long l = -1, string rep = "", long r = 0) AS STRING if r then ' if replacing if (l = -1) or (len(rep) < l) then l = len(rep) end if inp = left(inp, p-1) + mid(rep, 1, l) + mid(inp, p+l) else if l < 0 then function = mid(inp, p) else function = mid(inp, p, l) end if end if END FUNCTION ' END OF MID$.BIN ' STARTS LOWRD.BIN def LOWRD ((%1) and 0xffff) ' END OF LOWRD.BIN ' STARTS ISTRUE.BIN ' Returns -1 if the passed value is non-zero. FUNCTION ¤ISTRUE(long i) as long if i then return -1 end if END FUNCTION ' Returns -1 if the passed value is non-zero. FUNCTION ¤ISTRUE(quad i) as quad if i then return -1 end if END FUNCTION ' END OF ISTRUE.BIN ' STARTS ISFALSE.BIN ' Returns -1 if the passed value is zero. FUNCTION ¤ISFALSE(long i) as long if i=0 then return -1 end if END FUNCTION ' Returns -1 if the passed value is zero. FUNCTION ¤ISFALSE(quad i) as quad if i=0 then return -1 end if END FUNCTION ' END OF ISFALSE.BIN ' STARTS HIWRD.BIN def HIWRD(((%1)>>16) and 0xffff) ' END OF HIWRD.BIN ' STARTS FORMAT$.BIN FUNCTION ¤FORMATCODE(double dd, byref string f, int decimals) as string f += news(3) ' extra space to allow checking. int iPeriod = -1 int iCommas = 0 int iDigits = 0 int iPercent = 0 int iFill = 0 int i = 0 int cm = 0 int iBegin = 0 int ml = len(f)-3 string o = "" int p[2] byte b at strptr(f) for i = 1 to ml select case b[i] case 44 ' , if iDigits then iCommas = 1 b[i] = 0 end if case 42 ' * iDigits += 1 if iPeriod != -1 then p[2] += 2 else p[1] += 2 end if iFill = b[i+1] b[i] = 2 b[i+1] = 2 i += 1 case 34 b[i] = 0 do i += 1 if b[i] = 34 then if b[i+1] != 34 then b[i] = 0 exit do end if end if loop case 92 ' \ b[i] = 0 if b[i+1] = 34 then if b[i+2] = 34 then b[i+2] = 0 i += 2 else b[i+1] = 0 i += 1 end if continue end if i += 1 case 48 iDigits += 1 if iPeriod != -1 then p[2] += 1 b[i] = 1 else p[1] += 1 b[i] = 1 end if case 35 iDigits += 1 if iPeriod != -1 then p[2] += 1 b[i] = 2 else p[1] += 1 b[i] = 2 end if case 37 b[i] = 0 iPercent = 1 case 46 if iPeriod = -1 then iPeriod = i end if CASE 32, 36, 38, 40, 41, 43, 45 ' these are allowed directly... case else ' anything else is removed. b[i] = 0 end select next i if iPeriod = -1 then iBegin = ml else iBegin = iPeriod end if if iPercent then dd = (dd * 100) end if '#IF X64 ' there is currently a bug for 64 bit compilations. string ss = str(dd, p[2]) '#ELSE 'numberformat(decimals,1,0,1,1,0) 'string ss = str(dd) 'numberformat '#ENDIF ' split the real numbers. byte b at strptr(ss) string sValue = "" string sDecimal = "" for i = 1 to len(ss) if b[i] = 46 then sValue = left(ss, i-1) sDecimal = mid(ss, i+1) exit for elseif i = len(ss) then sValue = ss sDecimal = "" end if next i ' print ss chr(13, 10) ' print sValue chr(13, 10) ' print sDecimal chr(13, 10) ' print p[1] chr(13, 10) ' print ci chr(13, 10) byte b at strptr(f) int ci = len(sValue) byte n at strptr(sValue) 'first the integer part. cm = -1 for i = iBegin to 1 step -1 select case b[i] case 0 ' discard it! case 1, 2 ' 0 # p[1] -= 1 'print chr(n[ci]) " " ci " " p[1] chr(13, 10) if p[1] <= 0 then if ci then for ci = ci to 1 step -1 gosub addcomma o = chr(n[ci]) + o next ci elseif iFill then if b[i] = 2 then o = chr(iFill) + o end if end if elseif p[1] > 0 then if ci then gosub addcomma o = chr(n[ci]) + o ci -= 1 if (ci = 0) and (p[1]>0) then 'for ci = (p[1]-1) to 1 step -1 if iFill then o = chr(iFill) + o else o = "0" + o end if 'next end if elseif b[i] = 1 then gosub addcomma o = "0" + o elseif iFill then o = chr(iFill) + o end if end if case 45 if (dd<0) then if asc(mid(o, 1, 1)) <> 45 then o = chr(b[i]) + o end if else o = chr(b[i]) + o end if case else o = chr(b[i]) + o end select next i ' phew!! last... the decimals! int ci = 1 byte n at strptr(sDecimal) for i = iBegin+1 to ml select case b[i] case 0 ' discard it! case 1, 2 ' 0 # p[2] -= 1 if p[2] < 0 then if iFill then if b[i] = 2 then o += chr(iFill) end if end if elseif p[2] = 0 then if ci = len(sDecimal) then for ci = ci to len(sDecimal) o += chr(n[ci]) next ci if iPercent then o += "%" end if elseif ci > len(sDecimal) then if b[i] = 1 then o += "0" elseif iFill then o += chr(iFill) end if if iPercent then o += "%" end if elseif iFill then if b[i] = 2 then o += chr(iFill) end if end if elseif p[2] > 0 then if ci < len(sDecimal) then o += chr(n[ci]) ci += 1 elseif b[i] = 1 then o += "0" elseif iFill then o = chr(iFill) + o end if end if case else o += chr(b[i]) end select next i return o addcomma: if iCommas then cm += 1 if cm = 3 then cm = 0 o = "," + o end if end if ret END FUNCTION FUNCTION ¤FORMAT(double dd, string fs) AS STRING string f = fs if f = "" then if floor(dd) = dd then f = "0" else f = "0.0" end if elseif instr(f, ";") then if dd<0 then f = mid(f, instr(f, ";")+1) if instr(f, ";") then f = mid(f, 1, instr(f, ";")-1) end if elseif dd = 0 f = mid(f, instr(f, ";")+1) if instr(f, ";") then f = mid(f, instr(f, ";")+1) if instr(f, ";") then f = mid(f, 1, instr(f, ";")-1) end if else f = fs end if end if end if return ¤FORMATCODE(dd, f, 8) END FUNCTION FUNCTION ¤FORMAT(single dd) AS STRING string f = "0" return ¤FORMATCODE(dd, f, 8) END FUNCTION FUNCTION ¤FORMAT(quad dd) AS STRING string f = "0" return ¤FORMATCODE(dd, f, 0) END FUNCTION ' END OF FORMAT$.BIN ' STARTS DIALOGSETICON.BIN ' SUB DIALOGSETICON(sys hWnd, string sName) sys hIcon = ¤LoadIcon(GetModuleHandle(0), sName) ¤SendMessage(hWnd, 128, 0, hIcon) ¤SendMessage(hWnd, 128, 1, hIcon) END SUB ' END OF DIALOGSETICON.BIN ' STARTS CHOOSE&.BIN ' returns the selected field. FUNCTION CHOOSE(int c, byval int o[], int n) AS int if c < 1 then return 0 end if if c > n then return 0 end if return o[c] END FUNCTION ' END OF CHOOSE&.BIN ' STARTS ASCIIZ.BIN //Assigns a truncated null terminated string. MACRO ¤ASCZ_SET(v, c, l) if l < 2 then copy0(@v, chr(0), 1) else copy0(@v, left(c, l-1), l) end if END MACRO ' END OF ASCIIZ.BIN ' STARTS DIALOGSHOW.BIN Function DialogShow(BYVAL dMode AS LONG, BYVAL hDlg AS SYS, BYVAL hCallback AS DWORD, BYREF Result AS DWORD) AS LONG ¤MSG wm dword rr = 0 ¤HPROP *hdata @hData = ¤GetProp(hDlg, byval @¤DTT) If @hData Then hData.curProc = hCallback end if IF @hData THEN hData.oldProc = ¤GetWindowLong(hDlg, -4) END IF ¤SetWindowLong(hDlg, -4, @¤DEFAULT_CALLBACK_PROC) ¤SendMessage(hDlg, 272, hDlg, 0) ¤ShowWindow(hDlg, 5) if @Result then Result = 0 end if if dMode = 1 then while ¤GetMessage(wm,0,0,0) rr = ¤TranslateMessage(wm) ¤DispatchMessage(wm) IF ¤IsWindow(hDlg) = 0 THEN if @Result then Result = rr end if EXIT DO end if Wend end if end function ' END OF DIALOGSHOW.BIN ' STARTS DIALOGNEW.BIN ' STARTS CALLBACKDATA.BIN ' END OF CALLBACKDATA.BIN ' CONTINUES (1) DIALOGNEW.BIN FUNCTION DialogNew(BYVAL dMode AS LONG, byval hParent AS DWORD, BYVAL sCaption AS STRING, BYREF Xt AS LONG, BYREF Yt AS LONG, BYVAL W AS LONG, BYVAL H AS LONG, BYVAL pStyle AS DWORD, BYVAL pexStyle AS DWORD, BYREF Result AS DWORD) AS LONG ' Im clueless, dont ask me. single ratioX = 1.58 single ratioY = 1.82 '========================= sys hFont = ¤GetStockObject(17) long DX = 0 long dy = 0 long dw = 0 long dH = 0 long dStyle = 0 long exStyle = 0 if @pStyle then dStyle = pStyle end if if @pexStyle then exStyle = pexStyle end if SELECT CASE dMode case 0, 6 ' UNITS. dw = w * RatioX dh = h * RatioY IF @Xt=0 THEN dx = (¤GetSystemMetrics(0)/2) - (dw/2) ELSE dx = Xt * RatioX END IF if @Yt=0 then dy = (¤GetSystemMetrics(1)/2) - (dh/2) else dy = Yt * RatioY end if case 5 ' PIXELS if @Xt=0 then DX = (¤GetSystemMetrics(0)/2) - (w/2) ELSE DX = Xt end if if @Yt=0 then dy = (¤GetSystemMetrics(1)/2) - (h/2) ELSE dy = Yt end if dw = w Dh = h IF ((exStyle and 128) = 128) then ' WS_EX_TOOLWINDOW dh += ¤GetSystemMetrics(bycopy 51) ELSEIF ((dStyle and 12582912) = 12582912) then ' WS_CAPTION dh += ¤GetSystemMetrics(bycopy 4) END IF if ((dStyle and 262144) = 262144) then ' WS_THICKFRAME dw += (2 * ¤GetSystemMetrics(bycopy 32)) ' SM_CXSIZEFRAME dh += (2 * ¤GetSystemMetrics(bycopy 33)) ' SM_CYSIZEFRAME end if case 7 ' DPIAWARE END SELECT Result = ¤CreateWindowEx(exStyle,_ 'extended styles "DDTDialog", _ 'window class name sCaption,_ 'window caption dStyle,_ 'window style DX, _ 'initial x position dy, _ 'initial y position dw, _ 'initial x size DH, _ 'initial y size hParent, _ 'parent window handle 0, _ 'window menu handle ¤GetModuleHandle(0), _ 'program instance handle 0) 'creation parameter if Result then ¤SendMessage(Result, 48, hFont, 0) ¤HPROP *hdata @hData = getmemory(SizeOf(¤HPROP)) If @hData Then hData.elem = 1 hData.dMode = dMode ¤SetProp(Result, byval @¤DTT, @hData) end if end if END FUNCTION ' END OF DIALOGNEW.BIN % ½GAME_W = 256 % ½GAME_H = 224 % ½TIMER_REFRESHSCREEN = 1001 % ½AREA_VIRUS = 1 % ½AREA_BLOCK = 2 % ½AREA_PILL = 3 % ½AREA_HALFPILL = 4 % ½BOTTLE_X = 96 % ½BOTTLE_Y = 72 % ½VIRUS_NORMAL = 0 % ½VIRUS_FLOOR = 1 % ½VIRUS_DEAD = 3 % ½DIR_UP = 1 % ½DIR_RT = 2 % ½DIR_DN = 3 % ½DIR_LF = 4 % ½COLOR_RED = 1 % ½COLOR_YELLOW = 2 % ½COLOR_BLUE = 3 % ½NULL = 0 % ½SRCCOPY = 13369376 % ½VK_LEFT = 37 % ½VK_RIGHT = 39 % ½VK_DOWN = 40 % ½VK_X = 88 % ½VK_Z = 90 % ½WM_DESTROY = 2 % ½WM_PAINT = 15 % ½WM_INITDIALOG = 272 % ½WM_TIMER = 275 % ½WS_OVERLAPPEDWINDOW = 13565952 % ½FD_SETSIZE = 64 % ½SND_ASYNC = 1 % ½SND_RESOURCE = 262148 TYPE PILL INT active INT lfcolor INT rtcolor INT xa INT ya INT x INT y INT d INT step SINGLE mome INT dir END TYPE TYPE GAMEDATA BYTE switchframe BYTE level PILL nextpill PILL curpill INT pilldir BYTE viruses DWORD hiscore DWORD score BYTE music INT curframe INT pillnum INT pilldelay INT rotated INT moved INT movestep INT curbond INT redhit INT bluehit INT yellowhit INT clear INT mariostep INT marioframe INT throwpill INT falling END TYPE TYPE AREATYPE INT color INT block INT dir INT step INT bond END TYPE TYPE BIGVIRUS INT x INT y INT yo INT state INT steps BYTE frame INT color END TYPE TYPE POINT INT x INT y END TYPE UNION RECT INT nleft INT ntop INT nright INT nbottom INT left INT top INT right INT bottom END UNION TYPE LV_ITEM DWORD mask INT iitem INT isubitem DWORD state DWORD statemask WCHAR* psztext[255] INT cchtextmax INT iimage INT lparam INT iindent END TYPE TYPE TVITEM DWORD mask DWORD hitem DWORD state DWORD statemask WCHAR* psztext[255] INT cchtextmax INT iimage INT iselectedimage INT cchildren INT lparam END TYPE TYPE PAINTSTRUCT DWORD hdc INT ferase RECT rcpaint INT frestore INT fincupdate BYTE rgbreserved[32] END TYPE ' SYSTEM CLASSES FOR ARRAYS: ¤TYPE_UDT_UDT(AREATYPE) ¤TYPE_UDT_UDT(BIGVIRUS) DECLARE FUNCTION BITBLT LIB "GDI32.DLL" ALIAS "BitBlt" (BYVAL P1 AS DWORD, BYVAL P2 AS INT, BYVAL P3 AS INT, BYVAL P4 AS INT, BYVAL P5 AS INT, BYVAL P6 AS DWORD, BYVAL P7 AS INT, BYVAL P8 AS INT, BYVAL P9 AS DWORD) AS INT DECLARE FUNCTION CREATECOMPATIBLEBITMAP LIB "GDI32.DLL" ALIAS "CreateCompatibleBitmap" (BYVAL P1 AS DWORD, BYVAL P2 AS INT, BYVAL P3 AS INT) AS DWORD DECLARE FUNCTION CREATECOMPATIBLEDC LIB "GDI32.DLL" ALIAS "CreateCompatibleDC" (BYVAL P1 AS DWORD) AS DWORD DECLARE FUNCTION DELETEDC LIB "GDI32.DLL" ALIAS "DeleteDC" (BYVAL P1 AS DWORD) AS INT DECLARE FUNCTION DELETEOBJECT LIB "GDI32.DLL" ALIAS "DeleteObject" (BYVAL P1 AS DWORD) AS INT DECLARE FUNCTION SELECTOBJECT LIB "GDI32.DLL" ALIAS "SelectObject" (BYVAL P1 AS DWORD, BYVAL P2 AS DWORD) AS DWORD DECLARE FUNCTION STRETCHBLT LIB "GDI32.DLL" ALIAS "StretchBlt" (BYVAL P1 AS DWORD, BYVAL P2 AS INT, BYVAL P3 AS INT, BYVAL P4 AS INT, BYVAL P5 AS INT, BYVAL P6 AS DWORD, BYVAL P7 AS INT, BYVAL P8 AS INT, BYVAL P9 AS INT, BYVAL P10 AS INT, BYVAL P11 AS DWORD) AS INT DECLARE FUNCTION GETASYNCKEYSTATE LIB "User32.dll" ALIAS "GetAsyncKeyState" (BYVAL P1 AS INT) AS SHORT DECLARE FUNCTION SETTIMER LIB "User32.dll" ALIAS "SetTimer" (BYVAL P1 AS DWORD, BYVAL P2 AS DWORD, BYVAL P3 AS DWORD, BYVAL P4 AS DWORD) AS DWORD DECLARE FUNCTION KILLTIMER LIB "User32.dll" ALIAS "KillTimer" (BYVAL P1 AS DWORD, BYVAL P2 AS DWORD) AS INT DECLARE FUNCTION BEGINPAINT LIB "User32.dll" ALIAS "BeginPaint" (BYVAL P1 AS DWORD, P2 AS PAINTSTRUCT) AS DWORD DECLARE FUNCTION ENDPAINT LIB "User32.dll" ALIAS "EndPaint" (BYVAL P1 AS DWORD, P2 AS PAINTSTRUCT) AS INT DECLARE FUNCTION INVALIDATERECT LIB "User32.dll" ALIAS "InvalidateRect" (BYVAL P1 AS DWORD, P2 AS RECT, BYVAL P3 AS INT) AS INT DECLARE FUNCTION GETCLIENTRECT LIB "User32.dll" ALIAS "GetClientRect" (BYVAL P1 AS DWORD, P2 AS RECT) AS INT DECLARE FUNCTION LOADBITMAP LIB "User32.dll" ALIAS "LoadBitmapW" (BYVAL P1 AS DWORD, P2 AS WZSTRING) AS DWORD DECLARE FUNCTION SNDPLAYSOUND LIB "WINMM.DLL" ALIAS "sndPlaySoundW" (P1 AS WZSTRING, BYVAL P2 AS DWORD) AS INT DECLARE FUNCTION MCISENDSTRING LIB "WINMM.DLL" ALIAS "mciSendStringW" (P1 AS WZSTRING, P2 AS WZSTRING, BYVAL P3 AS DWORD, BYVAL P4 AS DWORD) AS DWORD DECLARE FUNCTION PLAY_MIDI(BYVAL P1 AS STRING) AS INT DECLARE FUNCTION SETAREAFORLEVEL(BYVAL P1 AS INT) AS INT DECLARE SUB INITGAME() DECLARE FUNCTION PILLCANGO(BYVAL P1 AS INT) AS INT DECLARE FUNCTION LEAVEPILL() AS INT DECLARE FUNCTION MOVEPILL(BYVAL P1 AS INT) AS INT DECLARE FUNCTION CANROTATE() AS INT DECLARE FUNCTION CHECKVERT(BYVAL P1 AS INT, BYVAL P2 AS INT) AS INT DECLARE FUNCTION REMAININGVIRUS(BYVAL P1 AS INT) AS INT DECLARE FUNCTION CHECKHORZ(BYVAL P1 AS INT, BYVAL P2 AS INT) AS INT DECLARE FUNCTION INDIVIDUALIZEBLOCKS() AS INT DECLARE FUNCTION DESTROYED() AS INT DECLARE FUNCTION BLOCKFELL() AS INT DECLARE FUNCTION ROTATEPILL(BYVAL P1 AS INT) AS INT DECLARE FUNCTION EXECGAMEMECHANICS() AS INT DECLARE FUNCTION PBMAIN() AS INT DECLARE FUNCTION DLGPROC() AS INT declare function ¤srand lib "msvcrt.dll" alias "srand" (int seed) DWORD hvirbg DWORD hvirsm DWORD hmario DWORD hnumbr DWORD hbackg GAMEDATA config new ¤ARR_AREATYPE area(0, int{0, 0}, -1, 0, 0, "UDT", 20, 20, 0) new ¤ARR_BIGVIRUS bigv(0, int{0, 0}, -1, 0, 0, "UDT", 20, 25, 0) ' Initializes various things in the script. FUNCTION PluriBASIC_Initialize() AS LONG END FUNCTION FUNCTION PLAY_MIDI(STRING »fname) AS INT INT ¤RETVAL = 0 ¤SYSERR Err STRING fname = »fname ASCIIZ temp[257] INT r r = (MCISENDSTRING("open " + fname + " type sequencer alias midifile", ½NULL, 0, ½NULL)) IF (r=0) THEN MCISENDSTRING("status midifile length", ½NULL, 0, ½NULL) ¤RETVAL = VAL(temp) MCISENDSTRING("play midifile", 0, 0, 0) ELSE END IF RETURN ¤RETVAL END FUNCTION FUNCTION SETAREAFORLEVEL(INT »lvl) AS INT INT ¤RETVAL = 0 ¤SYSERR Err INT lvl = »lvl INT x INT y INT thecolor INT numvirus INT numblock INT highest Randomize(TIMER()) IF lvl < 0 THEN lvl = (0) ELSEIF lvl > 20 THEN lvl = (20) END IF x = 0 gosub .£FNini0360 goto .£FNind0360 ..£FNini0360 int ¤ite0360 int ¤iti0360 = 1 INT ¤tov0360 = 9 RET ..£FNind0360 FOR ¤ite0360 = 0 TO 2 STEP 1 ..£FNst0360 if (¤ite0360 > 0) then x += 1 if x > ¤tov0360 then exit for end if y = 0 gosub .£FNini0361 goto .£FNind0361 ..£FNini0361 int ¤ite0361 int ¤iti0361 = 1 INT ¤tov0361 = 17 RET ..£FNind0361 FOR ¤ite0361 = 0 TO 2 STEP 1 ..£FNst0361 if (¤ite0361 > 0) then y += 1 if y > ¤tov0361 then exit for end if ¤UDT_SETV(area, area.m(x,y), (4), LONG, (0), 4) ¤ite0361 += 1 if ¤iti0361 = 0 then gosub .£FNini0361 end if goto .£FNst0361 NEXT ¤ite0360 += 1 if ¤iti0360 = 0 then gosub .£FNini0360 end if goto .£FNst0360 NEXT thecolor = (0) numvirus = (((lvl + 1) * 4)) ¤MEM_SETV(config, (94), BYTE, ¤BytOvf(numvirus), 1) highest = ((12 - (lvl / 3))) IF y < 3 THEN y = (3) END IF DO WHILE numvirus x = (RND(1, 8)) y = (RND(highest, 16)) IF (area.lng(area.m(x,y), (0))=0) THEN numvirus = ((numvirus) - 1) thecolor = ((thecolor) + 1) ¤UDT_SETV(area, area.m(x,y), (8), LONG, (0), 4) ¤UDT_SETV(area, area.m(x,y), (4), LONG, (½AREA_VIRUS), 4) IF thecolor > 3 THEN ¤UDT_SETV(area, area.m(x,y), (0), LONG, (RND(1, 3)), 4) ELSE ¤UDT_SETV(area, area.m(x,y), (0), LONG, (thecolor), 4) END IF END IF LOOP ¤MEM_SETV(config, (104), LONG, (0), 4) ¤MEM_SETV(config, (108), LONG, (0), 4) ¤MEM_SETV(config, (152), LONG, (3), 4) ¤MEM_SETV(config, (148), LONG, (0), 4) ¤MEM_SETV(config, (112), LONG, ((31 - lvl)), 4) ¤MEM_SETV(config, (2 + 32), LONG, (0), 4) ¤MEM_SETV(config, (2 + 20), LONG, (188), 4) ¤MEM_SETV(config, (2 + 24), LONG, (64), 4) ¤MEM_SETV(config, (2 + 40), LONG, (½DIR_RT), 4) ¤MEM_SETV(config, (2 + 4), LONG, (CHOOSE(RND(1, 3), INT {½COLOR_RED, ½COLOR_YELLOW, ½COLOR_BLUE}, countof)), 4) ¤MEM_SETV(config, (2 + 8), LONG, (CHOOSE(RND(1, 3), INT {½COLOR_RED, ½COLOR_YELLOW, ½COLOR_BLUE}, countof)), 4) ¤UDT_RESET(44, (@config + 46)) BYTE ¤SCV39 = EXE.byt(@config, 103) IF ¤SCV39 = 1 THEN PLAY_MIDI("chill.mid") ELSEIF ¤SCV39 = 2 THEN PLAY_MIDI("fever2.mid") ELSE PLAY_MIDI("fever2.mid") END IF RETURN ¤RETVAL END FUNCTION SUB INITGAME() ¤SYSERR Err area.redim(0, int{0, 9, 0, 17}, countof) bigv.redim(0, int{0, 3}, countof) END SUB FUNCTION PILLCANGO(INT »dir) AS INT INT ¤RETVAL = 0 ¤SYSERR Err INT dir = »dir INT ¤SCV40 = dir IF ¤SCV40 = ½DIR_DN THEN IF EXE.lng(@config, 46 + 16) > 15 THEN RETURN ¤RETVAL END IF IF area.lng(area.m(EXE.lng(@config, 46 + 12),EXE.lng(@config, 46 + 16) + 1), (0)) THEN RETURN ¤RETVAL END IF INT ¤SCV41 = EXE.lng(@config, 46 + 40) IF ¤SCV41 = ½DIR_LF or ¤SCV41 = ½DIR_RT THEN IF area.lng(area.m(EXE.lng(@config, 46 + 12) + 1,EXE.lng(@config, 46 + 16) + 1), (0)) THEN RETURN ¤RETVAL END IF END IF ELSEIF ¤SCV40 = ½DIR_LF THEN IF (EXE.lng(@config, 46 + 12)=1) THEN RETURN ¤RETVAL END IF INT ¤SCV42 = EXE.lng(@config, 46 + 40) IF ¤SCV42 = ½DIR_UP or ¤SCV42 = ½DIR_DN THEN IF area.lng(area.m(EXE.lng(@config, 46 + 12) - 1,EXE.lng(@config, 46 + 16) - 1), (0)) THEN RETURN ¤RETVAL END IF IF area.lng(area.m(EXE.lng(@config, 46 + 12) - 1,EXE.lng(@config, 46 + 16)), (0)) THEN RETURN ¤RETVAL END IF ELSEIF ¤SCV42 = ½DIR_LF or ¤SCV42 = ½DIR_RT THEN IF area.lng(area.m(EXE.lng(@config, 46 + 12) - 1,EXE.lng(@config, 46 + 16)), (0)) THEN RETURN ¤RETVAL END IF END IF ELSEIF ¤SCV40 = ½DIR_RT THEN INT ¤SCV43 = EXE.lng(@config, 46 + 40) IF ¤SCV43 = ½DIR_UP or ¤SCV43 = ½DIR_DN THEN IF EXE.lng(@config, 46 + 12) > 7 THEN RETURN ¤RETVAL END IF IF area.lng(area.m(EXE.lng(@config, 46 + 12) + 1,EXE.lng(@config, 46 + 16) - 1), (0)) THEN RETURN ¤RETVAL END IF IF area.lng(area.m(EXE.lng(@config, 46 + 12) + 1,EXE.lng(@config, 46 + 16)), (0)) THEN RETURN ¤RETVAL END IF ELSEIF ¤SCV43 = ½DIR_LF or ¤SCV43 = ½DIR_RT THEN IF EXE.lng(@config, 46 + 12) > 6 THEN RETURN ¤RETVAL END IF IF area.lng(area.m(EXE.lng(@config, 46 + 12) + 2,EXE.lng(@config, 46 + 16)), (0)) THEN RETURN ¤RETVAL END IF END IF END IF ¤RETVAL = -1 RETURN ¤RETVAL END FUNCTION FUNCTION LEAVEPILL() AS INT INT ¤RETVAL = 0 ¤SYSERR Err ¤MEM_INCR(config, (128), LONG, 1) INT ¤SCV44 = EXE.lng(@config, 46 + 40) IF ¤SCV44 = ½DIR_UP THEN ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12),EXE.lng(@config, 46 + 16) + 0), (4), LONG, (½AREA_PILL), 4) ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12),EXE.lng(@config, 46 + 16) + 0), (0), LONG, (EXE.lng(@config, 46 + 4)), 4) ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12),EXE.lng(@config, 46 + 16) + 0), (8), LONG, (½DIR_DN), 4) ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12),EXE.lng(@config, 46 + 16) + 0), (16), LONG, (EXE.lng(@config, 128)), 4) ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12),EXE.lng(@config, 46 + 16) - 1), (4), LONG, (½AREA_PILL), 4) ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12),EXE.lng(@config, 46 + 16) - 1), (0), LONG, (EXE.lng(@config, 46 + 8)), 4) ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12),EXE.lng(@config, 46 + 16) - 1), (8), LONG, (½DIR_UP), 4) ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12),EXE.lng(@config, 46 + 16) - 1), (16), LONG, (EXE.lng(@config, 128)), 4) ELSEIF ¤SCV44 = ½DIR_DN THEN ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12),EXE.lng(@config, 46 + 16) + 0), (4), LONG, (½AREA_PILL), 4) ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12),EXE.lng(@config, 46 + 16) + 0), (0), LONG, (EXE.lng(@config, 46 + 8)), 4) ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12),EXE.lng(@config, 46 + 16) + 0), (8), LONG, (½DIR_DN), 4) ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12),EXE.lng(@config, 46 + 16) + 0), (16), LONG, (EXE.lng(@config, 128)), 4) ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12),EXE.lng(@config, 46 + 16) - 1), (4), LONG, (½AREA_PILL), 4) ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12),EXE.lng(@config, 46 + 16) - 1), (0), LONG, (EXE.lng(@config, 46 + 4)), 4) ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12),EXE.lng(@config, 46 + 16) - 1), (8), LONG, (½DIR_UP), 4) ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12),EXE.lng(@config, 46 + 16) - 1), (16), LONG, (EXE.lng(@config, 128)), 4) ELSEIF ¤SCV44 = ½DIR_RT THEN ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12),EXE.lng(@config, 46 + 16)), (4), LONG, (½AREA_PILL), 4) ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12),EXE.lng(@config, 46 + 16)), (0), LONG, (EXE.lng(@config, 46 + 4)), 4) ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12),EXE.lng(@config, 46 + 16)), (8), LONG, (½DIR_LF), 4) ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12),EXE.lng(@config, 46 + 16)), (16), LONG, (EXE.lng(@config, 128)), 4) ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12) + 1,EXE.lng(@config, 46 + 16)), (4), LONG, (½AREA_PILL), 4) ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12) + 1,EXE.lng(@config, 46 + 16)), (0), LONG, (EXE.lng(@config, 46 + 8)), 4) ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12) + 1,EXE.lng(@config, 46 + 16)), (8), LONG, (½DIR_RT), 4) ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12) + 1,EXE.lng(@config, 46 + 16)), (16), LONG, (EXE.lng(@config, 128)), 4) ELSEIF ¤SCV44 = ½DIR_LF THEN ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12),EXE.lng(@config, 46 + 16)), (4), LONG, (½AREA_PILL), 4) ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12),EXE.lng(@config, 46 + 16)), (0), LONG, (EXE.lng(@config, 46 + 8)), 4) ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12),EXE.lng(@config, 46 + 16)), (8), LONG, (½DIR_LF), 4) ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12),EXE.lng(@config, 46 + 16)), (16), LONG, (EXE.lng(@config, 128)), 4) ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12) + 1,EXE.lng(@config, 46 + 16)), (4), LONG, (½AREA_PILL), 4) ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12) + 1,EXE.lng(@config, 46 + 16)), (0), LONG, (EXE.lng(@config, 46 + 4)), 4) ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12) + 1,EXE.lng(@config, 46 + 16)), (8), LONG, (½DIR_RT), 4) ¤UDT_SETV(area, area.m(EXE.lng(@config, 46 + 12) + 1,EXE.lng(@config, 46 + 16)), (16), LONG, (EXE.lng(@config, 128)), 4) END IF RETURN ¤RETVAL END FUNCTION FUNCTION MOVEPILL(INT »dir) AS INT INT ¤RETVAL = 0 ¤SYSERR Err INT dir = »dir INT ¤SCV45 = dir IF ¤SCV45 = ½DIR_DN THEN ¤MEM_INCR(config, (46 + 24), LONG, 8) ¤MEM_INCR(config, (46 + 16), LONG, 1) ELSEIF ¤SCV45 = ½DIR_LF THEN ¤MEM_DECR(config, (46 + 20), LONG, 8) ¤MEM_DECR(config, (46 + 12), LONG, 1) ELSEIF ¤SCV45 = ½DIR_RT THEN ¤MEM_INCR(config, (46 + 20), LONG, 8) ¤MEM_INCR(config, (46 + 12), LONG, 1) END IF RETURN ¤RETVAL END FUNCTION FUNCTION CANROTATE() AS INT INT ¤RETVAL = 0 ¤SYSERR Err INT ¤SCV46 = EXE.lng(@config, 46 + 40) IF ¤SCV46 = ½DIR_LF or ¤SCV46 = ½DIR_RT THEN IF area.lng(area.m(EXE.lng(@config, 46 + 12),EXE.lng(@config, 46 + 16) - 1), (0)) THEN IF area.lng(area.m(EXE.lng(@config, 46 + 12),EXE.lng(@config, 46 + 16) + 1), (0)) THEN RETURN ¤RETVAL ELSE MOVEPILL(½DIR_DN) END IF END IF ELSEIF ¤SCV46 = ½DIR_UP or ¤SCV46 = ½DIR_DN THEN IF ¤ISTRUE(EXE.lng(@config, 46 + 12) > 7) OR ¤ISTRUE(area.lng(area.m(EXE.lng(@config, 46 + 12) + 1,EXE.lng(@config, 46 + 16)), (0))) THEN IF area.lng(area.m(EXE.lng(@config, 46 + 12) - 1,EXE.lng(@config, 46 + 16)), (0)) THEN RETURN ¤RETVAL ELSE MOVEPILL(½DIR_LF) END IF END IF END IF ¤RETVAL = -1 RETURN ¤RETVAL END FUNCTION FUNCTION CHECKVERT(INT »x, INT »y) AS INT INT ¤RETVAL = 0 ¤SYSERR Err INT x = »x INT y = »y INT i INT v INT e IF ¤ISFALSE(area.lng(area.m(x,y), (0))) THEN RETURN ¤RETVAL END IF i = y gosub .£FNini0396 goto .£FNind0396 ..£FNini0396 int ¤ite0396 int ¤iti0396 = 1 INT ¤tov0396 = (y + 16) RET ..£FNind0396 FOR ¤ite0396 = 0 TO 2 STEP 1 ..£FNst0396 if (¤ite0396 > 0) then i += 1 if i > ¤tov0396 then exit for end if IF i > 16 THEN EXIT FOR END IF IF (area.lng(area.m(x,i), (0))=area.lng(area.m(x,y), (0)) THEN e = ((e) + 1) ELSE EXIT FOR END IF ¤ite0396 += 1 if ¤iti0396 = 0 then gosub .£FNini0396 end if goto .£FNst0396 NEXT IF e >= 4 THEN i = y gosub .£FNini0399 goto .£FNind0399 ..£FNini0399 int ¤ite0399 int ¤iti0399 = 1 INT ¤tov0399 = (y + 16) RET ..£FNind0399 FOR ¤ite0399 = 0 TO 2 STEP 1 ..£FNst0399 if (¤ite0399 > 0) then i += 1 if i > ¤tov0399 then exit for end if IF i > 16 THEN EXIT FOR END IF IF (area.lng(area.m(x,i), (0))=area.lng(area.m(x,y), (0)) THEN IF (area.lng(area.m(x,i), (0))=½AREA_VIRUS) THEN IF (area.lng(area.m(x,i), (0))=½COLOR_RED) THEN ¤MEM_SETV(config, (132), LONG, (1), 4) END IF IF (area.lng(area.m(x,i), (0))=½COLOR_BLUE) THEN ¤MEM_SETV(config, (136), LONG, (1), 4) END IF IF (area.lng(area.m(x,i), (0))=½COLOR_YELLOW) THEN ¤MEM_SETV(config, (140), LONG, (1), 4) END IF v = (-1) END IF ¤UDT_SETV(area, area.m(x,i), (4), LONG, (½AREA_BLOCK), 4) ¤UDT_SETV(area, area.m(x,i), (16), LONG, (0), 4) ¤UDT_SETV(area, area.m(x,i), (12), LONG, (1), 4) ELSE EXIT FOR END IF ¤ite0399 += 1 if ¤iti0399 = 0 then gosub .£FNini0399 end if goto .£FNst0399 NEXT IF v THEN ¤RETVAL = 2 ELSE ¤RETVAL = 1 END IF END IF RETURN ¤RETVAL END FUNCTION FUNCTION REMAININGVIRUS(INT »clr) AS INT INT ¤RETVAL = 0 ¤SYSERR Err INT clr = »clr INT x INT y INT nvirus IF (clr=0) THEN x = 1 gosub .£FNini0408 goto .£FNind0408 ..£FNini0408 int ¤ite0408 int ¤iti0408 = 1 INT ¤tov0408 = 8 RET ..£FNind0408 FOR ¤ite0408 = 0 TO 2 STEP 1 ..£FNst0408 if (¤ite0408 > 0) then x += 1 if x > ¤tov0408 then exit for end if y = 1 gosub .£FNini0409 goto .£FNind0409 ..£FNini0409 int ¤ite0409 int ¤iti0409 = 1 INT ¤tov0409 = 16 RET ..£FNind0409 FOR ¤ite0409 = 0 TO 2 STEP 1 ..£FNst0409 if (¤ite0409 > 0) then y += 1 if y > ¤tov0409 then exit for end if IF (area.lng(area.m(x,y), (0))=½AREA_VIRUS) THEN nvirus = ((nvirus) + 1) END IF ¤ite0409 += 1 if ¤iti0409 = 0 then gosub .£FNini0409 end if goto .£FNst0409 NEXT ¤ite0408 += 1 if ¤iti0408 = 0 then gosub .£FNini0408 end if goto .£FNst0408 NEXT ELSE x = 1 gosub .£FNini0411 goto .£FNind0411 ..£FNini0411 int ¤ite0411 int ¤iti0411 = 1 INT ¤tov0411 = 8 RET ..£FNind0411 FOR ¤ite0411 = 0 TO 2 STEP 1 ..£FNst0411 if (¤ite0411 > 0) then x += 1 if x > ¤tov0411 then exit for end if y = 1 gosub .£FNini0412 goto .£FNind0412 ..£FNini0412 int ¤ite0412 int ¤iti0412 = 1 INT ¤tov0412 = 16 RET ..£FNind0412 FOR ¤ite0412 = 0 TO 2 STEP 1 ..£FNst0412 if (¤ite0412 > 0) then y += 1 if y > ¤tov0412 then exit for end if IF (area.lng(area.m(x,y), (0))=½AREA_VIRUS) THEN IF (area.lng(area.m(x,y), (0))=clr) THEN nvirus = ((nvirus) + 1) END IF END IF ¤ite0412 += 1 if ¤iti0412 = 0 then gosub .£FNini0412 end if goto .£FNst0412 NEXT ¤ite0411 += 1 if ¤iti0411 = 0 then gosub .£FNini0411 end if goto .£FNst0411 NEXT END IF ¤RETVAL = nvirus RETURN ¤RETVAL END FUNCTION FUNCTION CHECKHORZ(INT »x, INT »y) AS INT INT ¤RETVAL = 0 ¤SYSERR Err INT x = »x INT y = »y INT i INT v INT e IF ¤ISFALSE(area.lng(area.m(x,y), (0))) THEN RETURN ¤RETVAL END IF i = x gosub .£FNini0417 goto .£FNind0417 ..£FNini0417 int ¤ite0417 int ¤iti0417 = 1 INT ¤tov0417 = (x + 8) RET ..£FNind0417 FOR ¤ite0417 = 0 TO 2 STEP 1 ..£FNst0417 if (¤ite0417 > 0) then i += 1 if i > ¤tov0417 then exit for end if IF i > 8 THEN EXIT FOR END IF IF (area.lng(area.m(i,y), (0))=area.lng(area.m(x,y), (0)) THEN e = ((e) + 1) ELSE EXIT FOR END IF ¤ite0417 += 1 if ¤iti0417 = 0 then gosub .£FNini0417 end if goto .£FNst0417 NEXT IF e >= 4 THEN i = x gosub .£FNini0420 goto .£FNind0420 ..£FNini0420 int ¤ite0420 int ¤iti0420 = 1 INT ¤tov0420 = (x + 8) RET ..£FNind0420 FOR ¤ite0420 = 0 TO 2 STEP 1 ..£FNst0420 if (¤ite0420 > 0) then i += 1 if i > ¤tov0420 then exit for end if IF i > 8 THEN EXIT FOR END IF IF (area.lng(area.m(i,y), (0))=area.lng(area.m(x,y), (0)) THEN IF (area.lng(area.m(i,y), (0))=½AREA_VIRUS) THEN IF (area.lng(area.m(i,y), (0))=½COLOR_RED) THEN ¤MEM_SETV(config, (132), LONG, (1), 4) END IF IF (area.lng(area.m(i,y), (0))=½COLOR_BLUE) THEN ¤MEM_SETV(config, (136), LONG, (1), 4) END IF IF (area.lng(area.m(i,y), (0))=½COLOR_YELLOW) THEN ¤MEM_SETV(config, (140), LONG, (1), 4) END IF v = (-1) END IF ¤UDT_SETV(area, area.m(i,y), (4), LONG, (½AREA_BLOCK), 4) ¤UDT_SETV(area, area.m(i,y), (16), LONG, (0), 4) ¤UDT_SETV(area, area.m(i,y), (12), LONG, (1), 4) ELSE EXIT FOR END IF ¤ite0420 += 1 if ¤iti0420 = 0 then gosub .£FNini0420 end if goto .£FNst0420 NEXT IF v THEN ¤RETVAL = 2 ELSE ¤RETVAL = 1 END IF END IF RETURN ¤RETVAL END FUNCTION FUNCTION INDIVIDUALIZEBLOCKS() AS INT INT ¤RETVAL = 0 ¤SYSERR Err INT x INT y x = 1 gosub .£FNini0428 goto .£FNind0428 ..£FNini0428 int ¤ite0428 int ¤iti0428 = 1 INT ¤tov0428 = 8 RET ..£FNind0428 FOR ¤ite0428 = 0 TO 2 STEP 1 ..£FNst0428 if (¤ite0428 > 0) then x += 1 if x > ¤tov0428 then exit for end if y = 1 gosub .£FNini0429 goto .£FNind0429 ..£FNini0429 int ¤ite0429 int ¤iti0429 = 1 INT ¤tov0429 = 16 RET ..£FNind0429 FOR ¤ite0429 = 0 TO 2 STEP 1 ..£FNst0429 if (¤ite0429 > 0) then y += 1 if y > ¤tov0429 then exit for end if IF (area.lng(area.m(x,y), (0))=½AREA_PILL) THEN IF (area.lng(area.m(x,y), (0))=area.lng(area.m(x - 1,y), (16)) THEN goto .£FNst0429 END IF IF (area.lng(area.m(x,y), (0))=area.lng(area.m(x + 1,y), (16)) THEN goto .£FNst0429 END IF IF (area.lng(area.m(x,y), (0))=area.lng(area.m(x,y - 1), (16)) THEN goto .£FNst0429 END IF IF (area.lng(area.m(x,y), (0))=area.lng(area.m(x,y + 1), (16)) THEN goto .£FNst0429 END IF ¤UDT_SETV(area, area.m(x,y), (16), LONG, (0), 4) ¤UDT_SETV(area, area.m(x,y), (4), LONG, (½AREA_HALFPILL), 4) END IF ¤ite0429 += 1 if ¤iti0429 = 0 then gosub .£FNini0429 end if goto .£FNst0429 NEXT ¤ite0428 += 1 if ¤iti0428 = 0 then gosub .£FNini0428 end if goto .£FNst0428 NEXT RETURN ¤RETVAL END FUNCTION FUNCTION DESTROYED() AS INT INT ¤RETVAL = 0 ¤SYSERR Err INT x INT y INT r INT v INT boom ¤MEM_SETV(config, (132), LONG, (0), 4) ¤MEM_SETV(config, (136), LONG, (0), 4) ¤MEM_SETV(config, (140), LONG, (0), 4) x = 1 gosub .£FNini0436 goto .£FNind0436 ..£FNini0436 int ¤ite0436 int ¤iti0436 = 1 INT ¤tov0436 = 6 RET ..£FNind0436 FOR ¤ite0436 = 0 TO 2 STEP 1 ..£FNst0436 if (¤ite0436 > 0) then x += 1 if x > ¤tov0436 then exit for end if y = 1 gosub .£FNini0437 goto .£FNind0437 ..£FNini0437 int ¤ite0437 int ¤iti0437 = 1 INT ¤tov0437 = 16 RET ..£FNind0437 FOR ¤ite0437 = 0 TO 2 STEP 1 ..£FNst0437 if (¤ite0437 > 0) then y += 1 if y > ¤tov0437 then exit for end if r = (CHECKHORZ(x, y)) IF r THEN IF (r=2) THEN v = (-1) END IF boom = (-1) END IF ¤ite0437 += 1 if ¤iti0437 = 0 then gosub .£FNini0437 end if goto .£FNst0437 NEXT ¤ite0436 += 1 if ¤iti0436 = 0 then gosub .£FNini0436 end if goto .£FNst0436 NEXT x = 1 gosub .£FNini0439 goto .£FNind0439 ..£FNini0439 int ¤ite0439 int ¤iti0439 = 1 INT ¤tov0439 = 8 RET ..£FNind0439 FOR ¤ite0439 = 0 TO 2 STEP 1 ..£FNst0439 if (¤ite0439 > 0) then x += 1 if x > ¤tov0439 then exit for end if y = 1 gosub .£FNini0440 goto .£FNind0440 ..£FNini0440 int ¤ite0440 int ¤iti0440 = 1 INT ¤tov0440 = 13 RET ..£FNind0440 FOR ¤ite0440 = 0 TO 2 STEP 1 ..£FNst0440 if (¤ite0440 > 0) then y += 1 if y > ¤tov0440 then exit for end if r = (CHECKVERT(x, y)) IF r THEN IF (r=2) THEN v = (-1) END IF boom = (-1) END IF ¤ite0440 += 1 if ¤iti0440 = 0 then gosub .£FNini0440 end if goto .£FNst0440 NEXT ¤ite0439 += 1 if ¤iti0439 = 0 then gosub .£FNini0439 end if goto .£FNst0439 NEXT IF boom THEN IF v THEN IF EXE.lng(@config, 132) THEN ¤UDT_SETV(bigv, bigv.m(1), (12), LONG, (½VIRUS_FLOOR), 4) ¤UDT_SETV(bigv, bigv.m(1), (16), LONG, (0), 4) END IF IF EXE.lng(@config, 140) THEN ¤UDT_SETV(bigv, bigv.m(2), (12), LONG, (½VIRUS_FLOOR), 4) ¤UDT_SETV(bigv, bigv.m(2), (16), LONG, (0), 4) END IF IF EXE.lng(@config, 136) THEN ¤UDT_SETV(bigv, bigv.m(3), (12), LONG, (½VIRUS_FLOOR), 4) ¤UDT_SETV(bigv, bigv.m(3), (16), LONG, (0), 4) END IF INDIVIDUALIZEBLOCKS() SNDPLAYSOUND(bycopy "sfx" & ¤FORMAT(9, byval 0), ½SND_RESOURCE OR ½SND_ASYNC) ¤RETVAL = 2 ELSE INDIVIDUALIZEBLOCKS() SNDPLAYSOUND(bycopy "sfx" & ¤FORMAT(8, byval 0), ½SND_RESOURCE OR ½SND_ASYNC) ¤RETVAL = 1 END IF END IF RETURN ¤RETVAL END FUNCTION FUNCTION BLOCKFELL() AS INT INT ¤RETVAL = 0 ¤SYSERR Err INT x INT y INT f y = 15 gosub .£FNini0448 goto .£FNind0448 ..£FNini0448 int ¤ite0448 int ¤iti0448 = 1 INT ¤tov0448 = 1 INT ¤cnt0448 = -1 RET ..£FNind0448 FOR ¤ite0448 = 0 TO 2 STEP 1 ..£FNst0448 if (¤ite0448 > 0) then y += ¤cnt0448 if ¤cnt0448 > 0 then if y > ¤tov0448 then exit for else if y < ¤tov0448 then exit for end if end if x = 8 gosub .£FNini0449 goto .£FNind0449 ..£FNini0449 int ¤ite0449 int ¤iti0449 = 1 INT ¤tov0449 = 1 INT ¤cnt0449 = -1 RET ..£FNind0449 FOR ¤ite0449 = 0 TO 2 STEP 1 ..£FNst0449 if (¤ite0449 > 0) then x += ¤cnt0449 if ¤cnt0449 > 0 then if x > ¤tov0449 then exit for else if x < ¤tov0449 then exit for end if end if INT ¤SCV47 = area.lng(area.m(x,y), (4)) IF ¤SCV47 = ½AREA_HALFPILL THEN IF (area.lng(area.m(x,y + 1), (0))=0) THEN ¤UDT_COPY(20, area.udt(area.p(x,y + 1), (0)), area.udt(area.p(x,y), (0))) area.reset(area.m(x,y)) f = (1) END IF ELSEIF ¤SCV47 = ½AREA_PILL THEN IF (area.lng(area.m(x,y), (0))=area.lng(area.m(x - 1,y), (16)) THEN IF ¤ISFALSE(area.lng(area.m(x - 1,y + 1), (4))) AND ¤ISFALSE(area.lng(area.m(x,y + 1), (4))) THEN ¤UDT_COPY(20, area.udt(area.p(x,y + 1), (0)), area.udt(area.p(x,y), (0))) area.reset(area.m(x,y)) ¤UDT_COPY(20, area.udt(area.p(x - 1,y + 1), (0)), area.udt(area.p(x - 1,y), (0))) area.reset(area.m(x - 1,y)) f = (1) END IF x = ((x) - 1) ELSE IF ¤ISFALSE(area.lng(area.m(x,y + 1), (4))) THEN ¤UDT_COPY(20, area.udt(area.p(x,y + 1), (0)), area.udt(area.p(x,y), (0))) area.reset(area.m(x,y)) f = (1) END IF END IF END IF ¤ite0449 += 1 if ¤iti0449 = 0 then gosub .£FNini0449 end if goto .£FNst0449 NEXT ¤ite0448 += 1 if ¤iti0448 = 0 then gosub .£FNini0448 end if goto .£FNst0448 NEXT ¤RETVAL = f RETURN ¤RETVAL END FUNCTION FUNCTION ROTATEPILL(INT »dir) AS INT INT ¤RETVAL = 0 ¤SYSERR Err INT dir = »dir SNDPLAYSOUND(bycopy "sfx" & ¤FORMAT(4, byval 0), ½SND_RESOURCE OR ½SND_ASYNC) INT ¤SCV48 = dir IF ¤SCV48 = ½DIR_LF THEN ¤MEM_SETV(config, (116), LONG, (1), 4) ¤MEM_DECR(config, (46 + 40), LONG, 1) IF EXE.lng(@config, 46 + 40) < 1 THEN ¤MEM_SETV(config, (46 + 40), LONG, (4), 4) END IF ELSEIF ¤SCV48 = ½DIR_RT THEN ¤MEM_SETV(config, (116), LONG, (1), 4) ¤MEM_INCR(config, (46 + 40), LONG, 1) IF EXE.lng(@config, 46 + 40) > 4 THEN ¤MEM_SETV(config, (46 + 40), LONG, (1), 4) END IF END IF RETURN ¤RETVAL END FUNCTION FUNCTION EXECGAMEMECHANICS() AS INT INT ¤RETVAL = 0 ¤SYSERR Err INT r ¤MEM_INCR(config, (104), LONG, 1) IF EXE.lng(@config, 104) > 80 THEN IF (EXE.lng(@config, 108)=0) THEN ¤MEM_INCR(config, (108), LONG, 1) ¤MEM_SETV(config, (156), LONG, (1), 4) ¤MEM_SETV(config, (2 + 32), LONG, (1), 4) ¤MEM_SETV(config, (2 + 20), LONG, (188), 4) ¤MEM_SETV(config, (2 + 24), LONG, (64), 4) ¤MEM_SETV(config, (2 + 36), SINGLE, (-8), 4) ELSEIF EXE.lng(@config, 156) THEN ¤MEM_INCR(config, (148), LONG, 1) ¤MEM_INCR(config, (2 + 36), SINGLE, 0.69) ¤MEM_INCR(config, (2 + 40), LONG, 1) IF EXE.lng(@config, 2 + 40) > 4 THEN ¤MEM_SETV(config, (2 + 40), LONG, (1), 4) END IF ¤MEM_DECR(config, (2 + 20), LONG, 3) ¤MEM_INCR(config, (2 + 24), LONG, EXE.sng(@config, 2 + 36)) INT ¤SCV49 = EXE.lng(@config, 148) IF ¤SCV49 = 4 THEN ¤MEM_SETV(config, (152), LONG, (4), 4) ELSEIF ¤SCV49 = 8 THEN ¤MEM_SETV(config, (152), LONG, (5), 4) ELSEIF ¤SCV49 = 23 THEN ¤MEM_SETV(config, (152), LONG, (3), 4) ¤MEM_SETV(config, (156), LONG, (0), 4) ¤UDT_COPY(44, (@config + 46), (@config + 2)) ¤MEM_SETV(config, (46 + 0), LONG, (1), 4) ¤MEM_MODV(config, (46 + 20), LONG, +, (1), 4) ¤MEM_MODV(config, (46 + 24), LONG, +, (2), 4) ¤MEM_SETV(config, (46 + 12), LONG, (4), 4) ¤MEM_SETV(config, (46 + 16), LONG, (1), 4) ¤MEM_SETV(config, (46 + 40), LONG, (½DIR_RT), 4) ¤MEM_SETV(config, (2 + 20), LONG, (188), 4) ¤MEM_SETV(config, (2 + 24), LONG, (64), 4) ¤MEM_SETV(config, (2 + 4), LONG, (CHOOSE(RND(1, 3), INT {½COLOR_RED, ½COLOR_YELLOW, ½COLOR_BLUE}, countof)), 4) ¤MEM_SETV(config, (2 + 8), LONG, (CHOOSE(RND(1, 3), INT {½COLOR_RED, ½COLOR_YELLOW, ½COLOR_BLUE}, countof)), 4) ¤MEM_SETV(config, (2 + 40), LONG, (½DIR_RT), 4) ¤MEM_SETV(config, (2 + 32), LONG, (0), 4) ¤MEM_SETV(config, (2 + 36), SINGLE, (-8), 4) ¤MEM_SETV(config, (148), LONG, (0), 4) END IF END IF END IF IF EXE.lng(@config, 46 + 0) THEN IF EXE.lng(@config, 160) THEN ¤MEM_INCR(config, (160), LONG, 1) IF EXE.lng(@config, 160) > 11 THEN ¤MEM_SETV(config, (160), LONG, (1), 4) IF EXE.lng(@config, 144) THEN ELSE IF (REMAININGVIRUS(0)=0) THEN ¤MEM_SETV(config, (144), LONG, (1), 4) ELSE IF BLOCKFELL() THEN SNDPLAYSOUND(bycopy "sfx" & ¤FORMAT(3, byval 0), ½SND_RESOURCE OR ½SND_ASYNC) ELSE r = (DESTROYED()) IF r THEN IF (REMAININGVIRUS(0)=0) THEN ¤MEM_SETV(config, (144), LONG, (1), 4) ELSE ¤MEM_SETV(config, (160), LONG, (1), 4) END IF ELSE ¤MEM_SETV(config, (160), LONG, (0), 4) ¤MEM_SETV(config, (156), LONG, (1), 4) END IF END IF END IF END IF END IF ELSEIF EXE.lng(@config, 156) THEN ELSE IF EXE.lng(@config, 116) THEN IF ¤ISFALSE(GETASYNCKEYSTATE(½VK_Z)) AND ¤ISFALSE(GETASYNCKEYSTATE(½VK_X)) THEN ¤MEM_SETV(config, (116), LONG, (0), 4) END IF ELSEIF GETASYNCKEYSTATE(½VK_Z) THEN IF CANROTATE() THEN ROTATEPILL(½DIR_LF) END IF ELSEIF GETASYNCKEYSTATE(½VK_X) THEN IF CANROTATE() THEN ROTATEPILL(½DIR_RT) END IF END IF IF GETASYNCKEYSTATE(½VK_DOWN) THEN ¤MEM_SETV(config, (120), LONG, (0), 4) ¤MEM_SETV(config, (124), LONG, (0), 4) IF PILLCANGO(½DIR_DN) THEN MOVEPILL(½DIR_DN) ELSE goto .£1EC5pillfell END IF ELSEIF EXE.lng(@config, 120) THEN IF GETASYNCKEYSTATE(EXE.lng(@config, 120)) THEN ¤MEM_INCR(config, (124), LONG, 1) IF EXE.lng(@config, 124) > 15 THEN IF (EXE.lng(@config, 120)=½VK_RIGHT) THEN IF PILLCANGO(½DIR_RT) THEN ¤MEM_SETV(config, (120), LONG, (½VK_RIGHT), 4) MOVEPILL(½DIR_RT) END IF ELSEIF (EXE.lng(@config, 120)=½VK_LEFT) THEN IF PILLCANGO(½DIR_LF) THEN ¤MEM_SETV(config, (120), LONG, (½VK_LEFT), 4) MOVEPILL(½DIR_LF) END IF END IF END IF ELSE ¤MEM_SETV(config, (120), LONG, (0), 4) ¤MEM_SETV(config, (124), LONG, (0), 4) END IF ELSE IF GETASYNCKEYSTATE(½VK_RIGHT) THEN IF PILLCANGO(½DIR_RT) THEN ¤MEM_SETV(config, (120), LONG, (½VK_RIGHT), 4) MOVEPILL(½DIR_RT) END IF ELSEIF GETASYNCKEYSTATE(½VK_LEFT) THEN IF PILLCANGO(½DIR_LF) THEN ¤MEM_SETV(config, (120), LONG, (½VK_LEFT), 4) MOVEPILL(½DIR_LF) END IF END IF END IF ¤MEM_INCR(config, (46 + 32), LONG, 1) IF ((EXE.lng(@config, 46 + 32) MOD EXE.lng(@config, 112))=0) THEN IF PILLCANGO(½DIR_DN) THEN MOVEPILL(½DIR_DN) ELSE ..£1EC5pillfell: Err.erp = "pillfell" SNDPLAYSOUND(bycopy "sfx" & ¤FORMAT(3, byval 0), ½SND_RESOURCE OR ½SND_ASYNC) LEAVEPILL() r = (DESTROYED()) IF r THEN ¤MEM_SETV(config, (160), LONG, (1), 4) ELSE ¤MEM_SETV(config, (156), LONG, (1), 4) END IF END IF END IF END IF END IF IF ((EXE.lng(@config, 104) MOD 4)=0) THEN IF EXE.byt(@config, 0) THEN ¤MEM_SETV(config, (0), BYTE, ¤BytOvf(0), 1) ELSE ¤MEM_SETV(config, (0), BYTE, ¤BytOvf(1), 1) END IF END IF RETURN ¤RETVAL END FUNCTION FUNCTION PBMAIN() AS INT INT ¤RETVAL = 0 CALL PluriBASIC_Initialize() ¤SYSERR Err INT hdlg INITGAME() DialogNew(5, 0, "DrMario - " & "OxygenBASIC", byval 0, byval 0, 256, 224, ½WS_OVERLAPPEDWINDOW, 0, hdlg) DialogSetIcon(hdlg, "DLGICON") DialogShow(1, hdlg, @DLGPROC, byval 0) RETURN ¤RETVAL END FUNCTION PBMAIN() ' invoke entry point EXTERN FUNCTION DLGPROC(sys cbhndl, uint cbMsg, sys wParam, sys lParam) as int callback INT ¤RETVAL = 0 ¤SYSERR Err STATIC SYS htimer STATIC INT hframe RECT rc DWORD hmemdc DWORD hmemdb DWORD hmembm DWORD holdbm DWORD holdbb DWORD hfont DWORD holdf DWORD hbrush SYS hdc INT offframe INT sprframe INT index INT xa INT ya INT x INT y PAINTSTRUCT ps INT xn3 INT wn4 INT p1n1 INT p2n2 INT p1n5 INT p2n6 STRING sn7 INT in8 INT tn9 INT nxna STRING snb INT inc INT tnd INT nxne INT ¤SCV50 = cbMsg IF ¤SCV50 = ½WM_INITDIALOG THEN ¤MEM_SETV(config, (95), DWORD, (42000), 4) hvirbg = (LOADBITMAP(GetModuleHandle(0), "VBIG")) hvirsm = (LOADBITMAP(GetModuleHandle(0), "VSML")) hmario = (LOADBITMAP(GetModuleHandle(0), "DRMA")) hnumbr = (LOADBITMAP(GetModuleHandle(0), "NUMR")) hbackg = (LOADBITMAP(GetModuleHandle(0), "BACK")) htimer = (SETTIMER(cbhndl, ½TIMER_REFRESHSCREEN, 20, ½NULL)) ¤UDT_SETV(bigv, bigv.m(1), (0), LONG, (43), 4) ¤UDT_SETV(bigv, bigv.m(1), (4), LONG, (132), 4) ¤UDT_SETV(bigv, bigv.m(1), (21), LONG, (½COLOR_RED), 4) ¤UDT_SETV(bigv, bigv.m(2), (0), LONG, (15), 4) ¤UDT_SETV(bigv, bigv.m(2), (4), LONG, (146), 4) ¤UDT_SETV(bigv, bigv.m(2), (21), LONG, (½COLOR_YELLOW), 4) ¤UDT_SETV(bigv, bigv.m(3), (0), LONG, (40), 4) ¤UDT_SETV(bigv, bigv.m(3), (4), LONG, (163), 4) ¤UDT_SETV(bigv, bigv.m(3), (21), LONG, (½COLOR_BLUE), 4) SETAREAFORLEVEL(10) ELSEIF ¤SCV50 = ½WM_DESTROY THEN IF htimer THEN KILLTIMER cbhndl, htimer END IF SLEEP 100 DELETEOBJECT hvirbg DELETEOBJECT hvirsm DELETEOBJECT hmario DELETEOBJECT hnumbr DELETEOBJECT hbackg ELSEIF ¤SCV50 = ½WM_TIMER THEN INT ¤SCV51 = wParam IF ¤SCV51 = ½TIMER_REFRESHSCREEN THEN EXECGAMEMECHANICS() GETCLIENTRECT(cbhndl, rc) hframe = (1) INVALIDATERECT cbhndl, rc, 0 END IF ELSEIF ¤SCV50 = ½WM_PAINT THEN IF hframe THEN hframe = (0) hdc = (BEGINPAINT(cbhndl, ps)) hmemdc = (CREATECOMPATIBLEDC(hdc)) hmemdb = (CREATECOMPATIBLEDC(hdc)) hmembm = (CREATECOMPATIBLEBITMAP(hdc, ½GAME_W, ½GAME_H)) holdbm = (SELECTOBJECT(hmemdc, hmembm)) holdbb = (SELECTOBJECT(hmemdb, hbackg)) BITBLT hmemdc, 0, 0, ½GAME_W, ½GAME_H, hmemdb, 0, 0, ½SRCCOPY holdbb = (SELECTOBJECT(hmemdb, holdbb)) holdbb = (SELECTOBJECT(hmemdb, hvirbg)) index = 1 gosub .£FNini0497 goto .£FNind0497 ..£FNini0497 int ¤ite0497 int ¤iti0497 = 1 INT ¤tov0497 = 3 RET ..£FNind0497 FOR ¤ite0497 = 0 TO 2 STEP 1 ..£FNst0497 if (¤ite0497 > 0) then index += 1 if index > ¤tov0497 then exit for end if INT ¤SCV52 = bigv.lng(bigv.m(index), (12)) IF ¤SCV52 = ½VIRUS_NORMAL THEN IF ((EXE.lng(@config, 104) MOD 8)=0) THEN ¤UDT_INCR(bigv, bigv.m(index), (20), BYTE, 1) END IF offframe = (bigv.byt(bigv.m(index), (20)) MOD 4) sprframe = (CHOOSE(offframe + 1, INT {1, 2, 3, 2}, countof)) x = ((24 * (sprframe - 1))) y = ((24 * (index - 1))) ELSEIF ¤SCV52 = ½VIRUS_DEAD THEN ¤UDT_INCR(bigv, bigv.m(index), (16), LONG, 1) IF bigv.lng(bigv.m(index), (16)) < 20 THEN x = ((24 * (7 - 1))) y = ((24 * (index - 1))) ELSE goto .£1EC7donotdrawvirus END IF ELSEIF ¤SCV52 = ½VIRUS_FLOOR THEN IF ((EXE.lng(@config, 104) MOD 3)=0) THEN ¤UDT_INCR(bigv, bigv.m(index), (20), BYTE, 1) END IF ¤UDT_INCR(bigv, bigv.m(index), (16), LONG, 1) offframe = (bigv.byt(bigv.m(index), (20)) MOD 2) sprframe = (CHOOSE((offframe + 1), INT {5, 6}, countof)) x = ((24 * (sprframe - 1))) y = ((24 * (index - 1))) IF bigv.lng(bigv.m(index), (16)) < 7 THEN INT ¤SCV53 = bigv.lng(bigv.m(index), (16)) IF ¤SCV53 = 1 THEN ¤UDT_SETV(bigv, bigv.m(index), (8), LONG, (-5), 4) ELSEIF ¤SCV53 = 2 THEN ¤UDT_SETV(bigv, bigv.m(index), (8), LONG, (-9), 4) ELSEIF ¤SCV53 = 3 THEN ¤UDT_SETV(bigv, bigv.m(index), (8), LONG, (-11), 4) ELSEIF ¤SCV53 = 4 THEN ¤UDT_SETV(bigv, bigv.m(index), (8), LONG, (-9), 4) ELSEIF ¤SCV53 = 5 THEN ¤UDT_SETV(bigv, bigv.m(index), (8), LONG, (-5), 4) ELSEIF ¤SCV53 = 6 THEN ¤UDT_SETV(bigv, bigv.m(index), (8), LONG, (0), 4) END IF END IF IF bigv.lng(bigv.m(index), (16)) > 80 THEN IF REMAININGVIRUS(bigv.lng(bigv.m(index), (21))) THEN ¤UDT_SETV(bigv, bigv.m(index), (12), LONG, (½VIRUS_NORMAL), 4) ELSE SNDPLAYSOUND(bycopy "sfx" & ¤FORMAT(11, byval 0), ½SND_RESOURCE OR ½SND_ASYNC) ¤UDT_SETV(bigv, bigv.m(index), (12), LONG, (½VIRUS_DEAD), 4) ¤UDT_SETV(bigv, bigv.m(index), (16), LONG, (0), 4) END IF END IF END IF BITBLT hmemdc, bigv.lng(bigv.m(index), (0)), bigv.lng(bigv.m(index), (4)) + bigv.lng(bigv.m(index), (8)), 24, 24, hmemdb, x, y, ½SRCCOPY ..£1EC7donotdrawvirus: Err.erp = "donotdrawvirus" ¤ite0497 += 1 if ¤iti0497 = 0 then gosub .£FNini0497 end if goto .£FNst0497 NEXT holdbb = (SELECTOBJECT(hmemdb, holdbb)) holdbb = (SELECTOBJECT(hmemdb, hvirsm)) xa = 0 gosub .£FNini0506 goto .£FNind0506 ..£FNini0506 int ¤ite0506 int ¤iti0506 = 1 INT ¤tov0506 = 9 RET ..£FNind0506 FOR ¤ite0506 = 0 TO 2 STEP 1 ..£FNst0506 if (¤ite0506 > 0) then xa += 1 if xa > ¤tov0506 then exit for end if ya = 0 gosub .£FNini0507 goto .£FNind0507 ..£FNini0507 int ¤ite0507 int ¤iti0507 = 1 INT ¤tov0507 = 17 RET ..£FNind0507 FOR ¤ite0507 = 0 TO 2 STEP 1 ..£FNst0507 if (¤ite0507 > 0) then ya += 1 if ya > ¤tov0507 then exit for end if INT ¤SCV54 = area.lng(area.m(xa,ya), (4)) IF ¤SCV54 = ½AREA_VIRUS THEN x = ((7 * EXE.byt(@config, 0))) y = ((7 * (area.lng(area.m(xa,ya), (0)) - 1))) BITBLT hmemdc, ½BOTTLE_X + ((xa * 8) - 8), ½BOTTLE_Y + ((ya * 8) - 8), 7, 7, hmemdb, x, y, ½SRCCOPY ELSEIF ¤SCV54 = ½AREA_HALFPILL THEN x = ((7 * 8)) y = ((7 * (area.lng(area.m(xa,ya), (0)) - 1))) BITBLT hmemdc, ½BOTTLE_X + ((xa * 8) - 8), ½BOTTLE_Y + ((ya * 8) - 8), 7, 7, hmemdb, x, y, ½SRCCOPY ELSEIF ¤SCV54 = ½AREA_PILL THEN x = ((7 * (area.lng(area.m(xa,ya), (8)) + 1))) y = ((7 * (area.lng(area.m(xa,ya), (0)) - 1))) BITBLT hmemdc, ½BOTTLE_X + ((xa * 8) - 8), ½BOTTLE_Y + ((ya * 8) - 8), 7, 7, hmemdb, x, y, ½SRCCOPY ELSEIF ¤SCV54 = ½AREA_BLOCK THEN IF area.lng(area.m(xa,ya), (12)) THEN ¤UDT_INCR(area, area.m(xa,ya), (12), LONG, 1) x = ((7 * 6)) y = ((7 * (area.lng(area.m(xa,ya), (0)) - 1))) IF area.lng(area.m(xa,ya), (12)) > 10 THEN ¤UDT_SETV(area, area.m(xa,ya), (4), LONG, (0), 4) ¤UDT_SETV(area, area.m(xa,ya), (0), LONG, (0), 4) ¤UDT_SETV(area, area.m(xa,ya), (12), LONG, (0), 4) END IF ELSE x = ((7 * 8)) y = ((7 * (area.lng(area.m(xa,ya), (0)) - 1))) END IF BITBLT hmemdc, ½BOTTLE_X + ((xa * 8) - 8), ½BOTTLE_Y + ((ya * 8) - 8), 7, 7, hmemdb, x, y, ½SRCCOPY END IF ¤ite0507 += 1 if ¤iti0507 = 0 then gosub .£FNini0507 end if goto .£FNst0507 NEXT ¤ite0506 += 1 if ¤iti0506 = 0 then gosub .£FNini0506 end if goto .£FNst0506 NEXT holdbb = (SELECTOBJECT(hmemdb, holdbb)) holdbb = (SELECTOBJECT(hmemdb, hmario)) INT ¤SCV55 = EXE.lng(@config, 152) IF ¤SCV55 = 3 or ¤SCV55 = 4 or ¤SCV55 = 5 THEN xn3 = (((EXE.lng(@config, 152) - 1) * 34)) wn4 = (30) END IF BITBLT hmemdc, 188, 68, wn4, 40, hmemdb, xn3, 0, ½SRCCOPY holdbb = (SELECTOBJECT(hmemdb, holdbb)) holdbb = (SELECTOBJECT(hmemdb, hvirsm)) INT ¤SCV56 = EXE.lng(@config, 2 + 40) IF ¤SCV56 = ½DIR_UP THEN xn3 = ((7 * (½DIR_DN + 1))) y = ((7 * (EXE.lng(@config, 2 + 4) - 1))) BITBLT hmemdc, EXE.lng(@config, 2 + 20), EXE.lng(@config, 2 + 24), 7, 7, hmemdb, xn3, y, ½SRCCOPY xn3 = ((7 * (½DIR_UP + 1))) y = ((7 * (EXE.lng(@config, 2 + 8) - 1))) BITBLT hmemdc, EXE.lng(@config, 2 + 20), EXE.lng(@config, 2 + 24) - 8, 7, 7, hmemdb, xn3, y, ½SRCCOPY ELSEIF ¤SCV56 = ½DIR_DN THEN xn3 = ((7 * (½DIR_DN + 1))) y = ((7 * (EXE.lng(@config, 2 + 8) - 1))) BITBLT hmemdc, EXE.lng(@config, 2 + 20), EXE.lng(@config, 2 + 24), 7, 7, hmemdb, xn3, y, ½SRCCOPY xn3 = ((7 * (½DIR_UP + 1))) y = ((7 * (EXE.lng(@config, 2 + 4) - 1))) BITBLT hmemdc, EXE.lng(@config, 2 + 20), EXE.lng(@config, 2 + 24) - 8, 7, 7, hmemdb, xn3, y, ½SRCCOPY ELSEIF ¤SCV56 = ½DIR_RT THEN xn3 = ((7 * (½DIR_LF + 1))) y = ((7 * (EXE.lng(@config, 2 + 4) - 1))) BITBLT hmemdc, EXE.lng(@config, 2 + 20), EXE.lng(@config, 2 + 24), 7, 7, hmemdb, xn3, y, ½SRCCOPY xn3 = (((7 * (½DIR_RT + 1)))) y = ((7 * (EXE.lng(@config, 2 + 8) - 1))) BITBLT hmemdc, EXE.lng(@config, 2 + 20) + 8, EXE.lng(@config, 2 + 24), 7, 7, hmemdb, xn3, y, ½SRCCOPY ELSEIF ¤SCV56 = ½DIR_LF THEN xn3 = ((7 * (½DIR_LF + 1))) y = ((7 * (EXE.lng(@config, 2 + 8) - 1))) BITBLT hmemdc, EXE.lng(@config, 2 + 20), EXE.lng(@config, 2 + 24), 7, 7, hmemdb, xn3, y, ½SRCCOPY xn3 = (((7 * (½DIR_RT + 1)))) y = ((7 * (EXE.lng(@config, 2 + 4) - 1))) BITBLT hmemdc, EXE.lng(@config, 2 + 20) + 8, EXE.lng(@config, 2 + 24), 7, 7, hmemdb, xn3, y, ½SRCCOPY END IF holdbb = (SELECTOBJECT(hmemdb, holdbb)) IF EXE.lng(@config, 46 + 0) THEN IF ¤ISFALSE(EXE.lng(@config, 160)) AND ¤ISFALSE(EXE.lng(@config, 156)) THEN holdbb = (SELECTOBJECT(hmemdb, hvirsm)) INT ¤SCV57 = EXE.lng(@config, 46 + 40) IF ¤SCV57 = ½DIR_UP THEN x = ((7 * (½DIR_DN + 1))) y = ((7 * (EXE.lng(@config, 46 + 4) - 1))) BITBLT hmemdc, EXE.lng(@config, 46 + 20), EXE.lng(@config, 46 + 24), 7, 7, hmemdb, x, y, ½SRCCOPY x = ((7 * (½DIR_UP + 1))) y = ((7 * (EXE.lng(@config, 46 + 8) - 1))) BITBLT hmemdc, EXE.lng(@config, 46 + 20), EXE.lng(@config, 46 + 24) - 8, 7, 7, hmemdb, x, y, ½SRCCOPY ELSEIF ¤SCV57 = ½DIR_DN THEN x = ((7 * (½DIR_DN + 1))) y = ((7 * (EXE.lng(@config, 46 + 8) - 1))) BITBLT hmemdc, EXE.lng(@config, 46 + 20), EXE.lng(@config, 46 + 24), 7, 7, hmemdb, x, y, ½SRCCOPY x = ((7 * (½DIR_UP + 1))) y = ((7 * (EXE.lng(@config, 46 + 4) - 1))) BITBLT hmemdc, EXE.lng(@config, 46 + 20), EXE.lng(@config, 46 + 24) - 8, 7, 7, hmemdb, x, y, ½SRCCOPY ELSEIF ¤SCV57 = ½DIR_RT THEN x = ((7 * (½DIR_LF + 1))) y = ((7 * (EXE.lng(@config, 46 + 4) - 1))) BITBLT hmemdc, EXE.lng(@config, 46 + 20), EXE.lng(@config, 46 + 24), 7, 7, hmemdb, x, y, ½SRCCOPY x = (((7 * (½DIR_RT + 1)))) y = ((7 * (EXE.lng(@config, 46 + 8) - 1))) BITBLT hmemdc, EXE.lng(@config, 46 + 20) + 8, EXE.lng(@config, 46 + 24), 7, 7, hmemdb, x, y, ½SRCCOPY ELSEIF ¤SCV57 = ½DIR_LF THEN x = ((7 * (½DIR_LF + 1))) y = ((7 * (EXE.lng(@config, 46 + 8) - 1))) BITBLT hmemdc, EXE.lng(@config, 46 + 20), EXE.lng(@config, 46 + 24), 7, 7, hmemdb, x, y, ½SRCCOPY x = (((7 * (½DIR_RT + 1)))) y = ((7 * (EXE.lng(@config, 46 + 4) - 1))) BITBLT hmemdc, EXE.lng(@config, 46 + 20) + 8, EXE.lng(@config, 46 + 24), 7, 7, hmemdb, x, y, ½SRCCOPY END IF holdbb = (SELECTOBJECT(hmemdb, holdbb)) END IF END IF IF EXE.dwd(@config, 99) > EXE.dwd(@config, 95) THEN ¤MEM_SETV(config, (95), DWORD, (EXE.dwd(@config, 99)), 4) END IF tn9 = EXE.dwd(@config, 95) sn7 = (¤FORMAT(tn9, REPEAT(7, "0"))) x = (16) y = (56) holdbb = (SELECTOBJECT(hmemdb, hnumbr)) in8 = 1 gosub .£FNini0517 goto .£FNind0517 ..£FNini0517 int ¤ite0517 int ¤iti0517 = 1 INT ¤tov0517 = 7 RET ..£FNind0517 FOR ¤ite0517 = 0 TO 2 STEP 1 ..£FNst0517 if (¤ite0517 > 0) then in8 += 1 if in8 > ¤tov0517 then exit for end if nxna = (VAL(¤MID(sn7, in8, 1, byval 0)) * 7) BITBLT hmemdc, x, y, 7, 7, hmemdb, nxna, 0, ½SRCCOPY x = ((x) + 8) ¤ite0517 += 1 if ¤iti0517 = 0 then gosub .£FNini0517 end if goto .£FNst0517 NEXT holdbb = (SELECTOBJECT(hmemdb, holdbb)) tnd = EXE.dwd(@config, 99) snb = (¤FORMAT(tnd, REPEAT(7, "0"))) x = (16) y = (80) holdbb = (SELECTOBJECT(hmemdb, hnumbr)) inc = 1 gosub .£FNini0518 goto .£FNind0518 ..£FNini0518 int ¤ite0518 int ¤iti0518 = 1 INT ¤tov0518 = 7 RET ..£FNind0518 FOR ¤ite0518 = 0 TO 2 STEP 1 ..£FNst0518 if (¤ite0518 > 0) then inc += 1 if inc > ¤tov0518 then exit for end if nxne = (VAL(¤MID(snb, inc, 1, byval 0)) * 7) BITBLT hmemdc, x, y, 7, 7, hmemdb, nxne, 0, ½SRCCOPY x = ((x) + 8) ¤ite0518 += 1 if ¤iti0518 = 0 then gosub .£FNini0518 end if goto .£FNst0518 NEXT holdbb = (SELECTOBJECT(hmemdb, holdbb)) GETCLIENTRECT(cbhndl, rc) STRETCHBLT hdc, 0, 0, EXE.lng(@rc, 8) - EXE.lng(@rc, 0), EXE.lng(@rc, 12) - EXE.lng(@rc, 4), hmemdc, 0, 0, ½GAME_W, ½GAME_H, ½SRCCOPY DELETEOBJECT(SELECTOBJECT(hmemdc, holdbm)) DELETEDC(hmemdc) DELETEDC(hmemdb) ENDPAINT(cbhndl, ps) END IF END IF RETURN ¤RETVAL END FUNCTION END EXTERN