REM Windows Features
DECLARE SUB DrawCheckedBox (posi%)
DECLARE SUB SetListBoxFocus (posi%, prev%)
DECLARE SUB CheckListBox ()
DEFINT A-Z
DECLARE SUB fprint (TEXT$, textx%, texty%, colour%, FILE%)
DECLARE SUB fopen (FILE$, FILE%)
DECLARE SUB redraw ()

'Subs Used by Text Boxes
'-------------------------
DECLARE SUB DRAWTEXTBOX (position%)
DECLARE SUB MTextBox (nam, X, Y, lenght, label$)
DECLARE SUB PutCharOnBox (letter$)
DECLARE SUB PrintLabel (TextBoxNum, clr)

'Subs Used by Buttons
'-------------------------
DECLARE SUB DrawButton (position)
DECLARE SUB mButton (nam, X, Y, lenght, label$)
DECLARE SUB PrintButtonLabel (ButtonNum, clr)
DECLARE SUB DrawButtonDown (position)

'Subs Used by List Boxes
'-------------------------
DECLARE SUB DrawListBox (position)
DECLARE SUB mListBox (nam, X, Y, XLEN, YLEN, label$)
DECLARE SUB UpdateListBox (position, top, way)



DECLARE SUB SetNewFocus ()
DECLARE SUB PlayWarning ()

'===========  PLEXER STUFF
DECLARE SUB Plexer (DTXT$)
DECLARE SUB scdelay (dl%)
DECLARE FUNCTION piqa% ()
DECLARE SUB scrnsaver ()
DECLARE SUB MainIntro ()
DECLARE SUB clearbot ()
DECLARE SUB OScall (na$)
DECLARE SUB initmem ()
DECLARE FUNCTION Capital! (L$)
DECLARE SUB initsound ()
DECLARE SUB PLsay (w$)
DECLARE SUB qbtalkos ()
DEFSNG A-Z


DECLARE SUB XMOUSE (which%)
DECLARE SUB TextPl (THP%, TVP%, TE$)
DECLARE SUB Plexer (DTXT$)
DECLARE SUB scdelay (dl%)
DECLARE FUNCTION piqa% ()
DECLARE SUB scrnsaver ()
DECLARE SUB MainIntro ()
DECLARE SUB clearbot ()
DECLARE SUB OScall (na$)
DECLARE SUB initmem ()


DEFSNG A-Z

'       The one and only
DECLARE SUB delay (tdelay!)

DECLARE SUB fixfna (filena$)
DECLARE SUB Qbprun (filena$)
DECLARE SUB exitroutine ()
DECLARE SUB udocs (ocs$, ocsm%)
DECLARE SUB cleartxt ()
DECLARE SUB grabtext ()
DECLARE SUB pastebgtext ()
DECLARE SUB typef ()
DECLARE SUB Pause (wlength%)
DECLARE SUB openfile (mh%, mv%)
DECLARE SUB DRAWWINDOWS ()
DECLARE SUB drawPointer ()
DECLARE SUB movewindow (mwct%, rsize%, bsize%)
DECLARE SUB IPxWindow (rsize%, bsize%, mc%, CT%, DTA$, DT%)
DECLARE SUB mouseButtons (CT%, BU%)
DECLARE SUB pxwindow (LH%, UV%, mr%, mb%, mc%, CT%, DT%, DTA$, ta%)
DECLARE SUB wamouse ()
DECLARE SUB mouse (CX%, DX%, BX%)
DECLARE SUB MOUSEPOINTER (SW%)
DECLARE SUB umouse (ya%, xa%, BU%, si%)
DECLARE SUB tmouse (mh%, mv%)
DECLARE SUB TBox (LH%, UV%, mr%, mb%, mc%)
DECLARE SUB Menus (Ril%, Bot%, mh%, mv%, BU%, ke$)

DECLARE SUB icons (H%, V%)
DECLARE SUB Crotate (DTA$, an%, qa%, ta%, swth%, shht%, sh%, sv%, ag1%, qa1%, ta1%)
DECLARE SUB percad (nm$, DTA$, CAD$)

DECLARE SUB pline (ag%, VR%, EA%, ANGLE%, sz%, X%, Y%, H%, V%, c%, size%, swth%, shht%)


DECLARE SUB WORLDSCALE (DTA$, SE$)
DECLARE SUB portdta (DTA$, CAD$)
DECLARE SUB getjoystick (di$)
DECLARE SUB ldsv (DTA$, CAD$, SE$)
DECLARE SUB delete (DTA$)
DECLARE SUB ROTATE (DTA$, an%, qa%, ta%, swth%, shht%, sh%, sv%)
DEFINT A-Z

DECLARE SUB VBCH (dat$, H%, V%, sz%, c%)
DECLARE SUB GETTX (DTA$, CT%, txt$, s%)
DECLARE SUB prtext (txt$, H%, V%, s%, c%, mr%, mb%)
DECLARE SUB GETVL (DTA$, CT%, sz%)


'COMMON SHARED BlasterAddr%, dma%, repeats%, HTO, oksk




'       The one and only
DECLARE SUB delay (tdelay!)

DECLARE SUB fixfna (filena$)
DECLARE SUB Qbprun (filena$)
DECLARE SUB exitroutine ()
DECLARE SUB udocs (ocs$, ocsm%)
DECLARE SUB cleartxt ()
DECLARE SUB grabtext ()
DECLARE SUB pastebgtext ()
DECLARE SUB typef ()
DECLARE SUB Pause (wlength%)
DECLARE SUB openfile (mh%, mv%)
DECLARE SUB DRAWWINDOWS ()
DECLARE SUB drawPointer ()
DECLARE SUB movewindow (mwct%, rsize%, bsize%)
DECLARE SUB IPxWindow (rsize%, bsize%, mc%, CT%, DTA$, DT%)
DECLARE SUB mouseButtons (CT%, BU%)
DECLARE SUB pxwindow (LH%, UV%, mr%, mb%, mc%, CT%, DT%, DTA$, ta%)
DECLARE SUB wamouse ()
'DECLARE SUB mouse (cx%, dx%, bx%)
DECLARE SUB MOUSEPOINTER (SW%)
DECLARE SUB umouse (ya%, xa%, BU%, si%)
DECLARE SUB tmouse (mh%, mv%)
DECLARE SUB TBox (LH%, UV%, mr%, mb%, mc%)
DECLARE SUB Menus (Ril%, Bot%, mh%, mv%, BU%, ke$)
DECLARE SUB arrow (H%, V%, H1%, V1%)
DECLARE SUB icons (H%, V%)
DECLARE SUB Crotate (DTA$, an%, qa%, ta%, swth%, shht%, sh%, sv%, ag1%, qa1%, ta1%)
DECLARE SUB percad (nm$, DTA$, CAD$)
DECLARE SUB QBCADLOGO ()
DECLARE SUB pline (ag%, VR%, EA%, ANGLE%, sz%, X%, Y%, H%, V%, c%, size%, swth%, shht%)
DECLARE SUB HELP ()
DECLARE SUB Ncad (DTA$)
DECLARE SUB WORLDSCALE (DTA$, SE$)
DECLARE SUB portdta (DTA$, CAD$)
DECLARE SUB getjoystick (di$)
DECLARE SUB ldsv (DTA$, CAD$, SE$)
DECLARE SUB delete (DTA$)
DECLARE SUB ROTATE (DTA$, an%, qa%, ta%, swth%, shht%, sh%, sv%)
DEFINT A-Z
DECLARE SUB edraw (ag%, qa%, ta%, DTA$, B%)
DECLARE SUB VBCH (dat$, H%, V%, sz%, c%)
DECLARE SUB GETTX (DTA$, CT%, txt$, s%)
DECLARE SUB prtext (txt$, H%, V%, s%, c%, mr%, mb%)
DECLARE SUB GETVL (DTA$, CT%, sz%)
DECLARE SUB DLINE (ag%, VR%, EA%, DMO%, H%, V%, X%, Y%, c%, BL%, n%, size%, swth%, shht%)
DECLARE SUB CDRAW (ag%, qa%, ta%, DTA$, B%)
DECLARE SUB VBDRAW (LH%, UV%, ag%, qa%, ta%, DTA$, H%, V%, B%, swth%, shht%)
DECLARE SUB sgline (ag%, VR%, EA%, ANGLE%, sz%, X%, Y%, H%, V%, c%, size%, BL%, n%, swth%, shht%)




'=============== MOUSE STUFF ==============
COMMON SHARED icns() AS STRING
COMMON SHARED thplim, tvplim, Ril, Bot, pxwct, mpticon, mh1, mv1

COMMON SHARED LH1, UV1, UPDATEW
COMMON SHARED MOUSEH, MOUSEV, mouseh1, mousev1, si, BU, hidew, sec, MCX, MDX

DIM SHARED DTXT$, ke$, lcmd$, bgcw$, Lstbgcw$, filena$, bgtext$, TIMEL$
DIM SHARED tmarry$(50, 3)
DIM SHARED marry(50, 8)
DIM SHARED box%(24, 24)
DIM SHARED mouser$, mouseleftbutton, mouserightbutton, MousexPos, MouseyPos, AX%, CX%, DX%, BX%

DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B
DATA 5E,08,8B,0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53
DATA 8B,5E,0C,89,07,58,8B,5E,0A,89,07,8B,5E,08,89,0F
DATA 8B,5E,06,89,17,5D,CA,08,00

' ==========================================
fopen "C:\DOS\bypass\fontS\SYSTEM.qbf", 1
fopen "C:\DOS\bypass\fontS\SYSTEM.qbf", 2
'CALL fprint(Text$, 5, 8, 1, FILE%)


TYPE TypeTextBox
 nam AS INTEGER
 X AS INTEGER
 Y AS INTEGER
 lenght AS INTEGER
 label AS STRING * 20
 maxtext AS INTEGER
 readtext AS STRING * 100
END TYPE

TYPE TypeButton
 nam AS INTEGER
 X AS INTEGER
 Y AS INTEGER
 lenght AS INTEGER
END TYPE

TYPE TypeListBox
 nam AS INTEGER
 X AS INTEGER
 XLEN AS INTEGER
 Y AS INTEGER
 YLEN AS INTEGER
 show AS INTEGER
 top AS INTEGER
 selected AS INTEGER
 NumItems AS INTEGER
 scrollspeed AS INTEGER         'Bigger the slower
 speedcounter AS INTEGER
 redraw AS INTEGER
END TYPE

DIM SHARED ObjectFocus

DIM SHARED MaxTextBoxes, ActiveTextBoxes, TextBoxFocus
MaxTextBoxes = 10
DIM SHARED TextBoxResult$(MaxTextBoxes)
DIM SHARED TextBox(MaxTextBoxes) AS TypeTextBox


DIM SHARED MaxButtons, ActiveButtons, ButtonFocus
MaxButtons = 10
DIM SHARED Button(MaxButtons) AS TypeButton, ButtonLabel$(MaxButtons)

DIM SHARED MaxListBoxes, MaxListItems, ActiveListBoxes, ListBoxFocus, ListBoxScrollingSpeed
MaxListBoxes = 5
MaxListItems = 20
ListBoxScrollingSpeed = 300    'The Bigger the Slower the List Boxes will scroll,
                               'the smaller, well, like a flash.
DIM SHARED ListBox(MaxListBoxes) AS TypeListBox, ListBoxContent$(MaxListBoxes, MaxListItems), ListBoxLabel$(MaxListBoxes), SelectedLine(MaxListBoxes)






SCREEN 12


   XMOUSE 0
   XMOUSE 3
   XMOUSE 5


COLOR 1
PAINT (1, 1), 9, 9


scrn = 13
'SCREEN 12
thplim = 79
tvplim = 27
mpticon = 1

'CALL initmem

proglock$ = "true": REM set to on

   mh1 = 1
   mv1 = 1
 SE$ = "1"
DTA1$ = DTA$
    'size = 100
    swth = 600
    shht = 400
    scale = 1
   sh = swth / 2
   sv = shht / 2
   H1 = sh
   V1 = sv
   VSCN = 1: REM VEIW SCREEN ON
'

ag = 1
qa = 2
ta = 1
B = 0
ag1 = ag
qa1 = qa
ta1 = ta
posnc = 10
PI = 3.142587
REM
sz = 1
DEFINT A-Z
scrn = 13
'SCREEN 12
thplim = 79
tvplim = 27
mpticon = 1

'CALL initmem

proglock$ = "true": REM set to on

   mh1 = 1
   mv1 = 1
 SE$ = "1"
DTA1$ = DTA$
    'size = 100
    swth = 600
    shht = 400
    scale = 1
   sh = swth / 2
   sv = shht / 2
   H1 = sh
   V1 = sv
   VSCN = 1: REM VEIW SCREEN ON


ag = 1
qa = 2
ta = 1
B = 0
ag1 = ag
qa1 = qa
ta1 = ta
posnc = 10
PI = 3.142587
REM
sz = 1

'CALL qbtalkos



  mpticon = 1' set to arrow

  'mpticon = 2' set to text
' 2
 'PALETTE 0, 9

0 sp = 10: REM
 Bot = 200
 Ril = 640
 'GET (0, 20)-(600, 200), BGPicture%
 CLS
10 c = 1:

30 LS = 30

50 ES = 5
si = 12

90  RANDOMIZE TIMER
 'h = 20: H1 = h
 'v = 20: V1 = v





'170 CLS




   'GET (H, V)-(H + si, V + si), box%
   CALL grabtext ' init screen



ocs$ = CHR$(219)



LOCATE 1, 1
COLOR 7


'fopen "C:\DOS\bypass\font3.qbf", 1
'fopen "C:\DOS\bypass\font3.qbf", 2


TextBoxFocus = 1
ButtonFocus = 0
ListBoxFocus = 1

'=========== CREATE YOUR 3D OBJECTS HERE ============

'mButton 1, 10, 50, 80, "3d Button"
'MTextBox 1, 150, 50, 100, "Text Box"
'MTextBox 2, 300, 50, 100, "Text Box 2"
'MTextBox 3, 450, 50, 100, "Text Box 3"

' Fill List Box 1

ListBox(1).NumItems = 20
ListBox(1).selected = ListBoxFocus

FOR ss = 1 TO 10
 READ one$
 ListBoxContent$(1, ss) = one$
NEXT ss
'mListBox 1, 100, 200, 100, 100, "List Box"

SetListBoxFocus 1, ListBoxFocus


' Start Main Loop
'================

  DO

LOCATE 1, 1
m = mem
PRINT "File Edit Tasks Options System Help [" + lcmd$ + " ] "; ocs$ + " "
'PRINT 'STRING$(79, CHR$(205));
 
    ' 3, 3: PRINT mouseh, mousev

    ke$ = INKEY$: ke$ = UCASE$(ke$)



410 B = STRIG(0): B = STRIG(B0)



  CALL mouseButtons(CT, BU)


  CALL umouse(ya, xa, BU, si)
  CALL tmouse(mh, mv)
  CALL Menus(Ril, Bot, mh, mv, BU, ke$)
  CALL drawPointer


LOCATE 23, 2: REM opperating system PROMPT

  'bckc$ = STRING$(79 - LEN(dtxt$), " ")

 Cktpd = Cktpd + 1


 IF ke$ <> "" THEN
  lc = ASC(LEFT$(ke$, 1)): rc = ASC(RIGHT$(ke$, 1))

   IF lc > 0 OR rc > 0 THEN sec = 0

 END IF
 IF lc > 0 AND LEN(DTXT$) <= 60 AND ke$ <> "" AND ke$ <> CHR$(13) AND ke$ <> CHR$(8) THEN DTXT$ = DTXT$ + ke$

   REM SCREEN SAVER
   sec = sec + 1
   IF sec > 1250 THEN
    CALL scrnsaver
    sec = 0
   END IF

   'LOCATE 21, 2: PRINT sec


 ' 15

 bckc$ = STRING$((thplim - LEN(DTXT$)), " ")

 IF pbd = 1 THEN
 PRINT "Ready#" + DTXT$ + " " + bckc$;
 pbd = 0
 ELSE
 pbd = 1
 PRINT "Ready " + DTXT$ + "_" + bckc$;
 Vosc$ = " "
 END IF

 Cktpd = 0


 'COLOR 7

 SELECT CASE ke$


 CASE IS = CHR$(0) + ";"


 CASE IS = CHR$(27)
      DTXT$ = ""

 CASE IS = CHR$(8)
 REM erase bad character

   ll = LEN(DTXT$)
   pc = (ll - 1)
   IF pc >= 0 THEN
   frg$ = LEFT$(DTXT$, pc)
 
   DTXT$ = frg$
   END IF


 CASE IS = CHR$(13)

  DTXT$ = UCASE$(DTXT$)

  CALL DRAWWINDOWS
  dtxt4$ = dtxt3$
  dtxt3$ = dtxt2$
  dtxt2$ = dtxt1$
  dtxt1$ = DTXT$


  CALL Plexer(DTXT$)


   'LOCATE mv1, mh1: PRINT Lstbgcw$


  LOCATE 3, 2

   lcmd$ = DTXT$
   cleartxt
  LOCATE 2, 1
   IF DTXT$ <> "" THEN
   SHELL DTXT$
   END IF
     bgtext$ = ""

     CALL grabtext
      wlength = 2
     CALL Pause(wlength)
      CALL clearbot
      XMOUSE (5)


  'GET (20, 0)-(600, 20 + 50), BGPicture

  'dtxt$ = ""
 END SELECT



  IF DTXT$ = "CLS" THEN
   

  END IF

  LOCATE 23, 15
  IF ke$ <> "" THEN

  lc = ASC(LEFT$(ke$, 1)): rc = ASC(RIGHT$(ke$, 1))
  END IF
  PRINT STR$(lc) + " " + STR$(rc)

    qa = qa + 1: IF qa > 360 THEN qa = 1
    ta = ta + 1: IF ta > 360 THEN ta = 1


    IF mpticon = 1 THEN CALL DRAWWINDOWS
    CALL udocs(ocs$, ocsm)
  
  LOCATE 23, 1
  ''PRINT STRING$(59, CHR$(205));

  '' 15
LOCATE 25, 1
  PRINT dtxt1$
LOCATE 26, 1
  PRINT dtxt2$
LOCATE 27, 1
  PRINT dtxt3$
LOCATE 28, 1
  PRINT dtxt4$;

LOCATE 26, 79 - 15
  PRINT TIME$
LOCATE 27, 79 - 15
  PRINT DATE$
 ' COLOR 7
  LOCATE 19, 15
  PRINT "<  "; filena$; " > ";

 IF TIME$ <> (TIMEL$) THEN
 
  UPDATEW = UPDATEW + 1
  IF UPDATEW > 5 THEN
   UPDATEW = 0
   END IF

   TIMEL$ = TIME$
END IF



 LOOP UNTIL proglock$ = "False"
 




CLOSE #1
CLOSE #2

 CALL exitroutine

'Data For List Box 1
'-------------------
DATA "File1", "File2", "File3", "File4", "File5", "File6", "File7", "File8", "File9", "File10", "File1", "File2", "File3", "File4", "File5", "File6", "File7", "File8", "File9", "File10"

SUB blanknnd (txt$, bckc$)
  'bckc$ = STRING$(79 - LEN(txt$), " ")



END SUB

SUB CheckListBox

FOR xx = 1 TO ActiveListBoxes
 X = ListBox(xx).X + 2
 Y = ListBox(xx).Y + 3
 XLEN = X + ListBox(xx).XLEN - 2
 YLEN = Y + ListBox(xx).YLEN - 2


 X1 = ListBox(xx).X + ListBox(xx).XLEN
 Y1 = ListBox(xx).Y
 Xmax1 = X1 + 10
 Ymax1 = Y1 + 15

 x2 = ListBox(xx).X + ListBox(xx).XLEN
 y2 = ListBox(xx).Y + ListBox(xx).YLEN
 Xmax2 = ListBox(xx).X + x2
 Ymax2 = ListBox(xx).Y + ListBox(xx).YLEN - 15

 top = ListBox(xx).top
 scrollspeed = ListBox(xx).scrollspeed


 IF (MousexPos >= X1) AND (MousexPos <= Xmax1) AND (MouseyPos >= Y1) AND (MouseyPos <= y2) THEN
  IF (MousexPos >= X1) AND (MousexPos <= Xmax1) AND (MouseyPos >= Y1) AND (MouseyPos <= Ymax1) THEN
   IF ListBox(xx).speedcounter = scrollspeed THEN
    ListBox(xx).speedcounter = 0
    UpdateListBox xx, top, 1
    
    EXIT FOR
   ELSE
    ListBox(xx).speedcounter = ListBox(xx).speedcounter + 1
   END IF
  ELSE
   IF (MousexPos >= x2) AND (MousexPos <= Xmax2) AND (MouseyPos <= y2) AND (MouseyPos >= Ymax2) THEN
    IF ListBox(xx).speedcounter = scrollspeed THEN
     ListBox(xx).speedcounter = 0
     UpdateListBox xx, top, 0
    ELSE
     ListBox(xx).speedcounter = ListBox(xx).speedcounter + 1
    END IF
    EXIT SUB
   END IF
  END IF
 ELSE
  IF (MousexPos >= X) AND (MousexPos <= XLEN) AND (MouseyPos >= Y) AND (MouseyPos <= YLEN) THEN
   IF ListBox(xx).speedcounter = scrollspeed THEN
    yposition = (MouseyPos - Y)
    prev = ListBox(xx).selected
    ListBox(xx).selected = INT(yposition \ 10) + 1
    ListBox(xx).redraw = 1
    SetListBoxFocus xx, prev
   ELSE
    ListBox(xx).speedcounter = ListBox(xx).speedcounter + 1
   END IF
  END IF
 END IF
NEXT xx




END SUB

SUB clearbot

ch$ = STRING$(79, " ")

LOCATE 25, 1
PRINT ch$
       
LOCATE 26, 1
PRINT ch$

LOCATE 27, 1
PRINT ch$

LOCATE 28, 1
PRINT ch$



END SUB

SUB cleartxt

LOCATE 2, 1
ch$ = STRING$(24, " ")


FOR V = 2 TO 23
PRINT ch$

NEXT V


END SUB

DEFSNG A-Z
SUB COLORBOX (c)

'h = Form1.ScaleWidth  '
'v = Form1.ScaleHeight ' REM CENTER SHAPE
LINE (H, V)-(H - 800, V - 800), c, BF
LINE (H, V)-(H + 50, V + 50), &HFF, BF

END SUB

DEFINT A-Z
SUB Crotate (DTA$, an, qa, ta, swth, shht, sh, sv, ag1, qa1, ta1)


 swth = 640
 shht = 400


ta1 = ta
 

  H1 = H
  V1 = V
h2 = h2
v2 = V1


DO
ta = ta + 5

IF ta > 360 THEN ta = 1

B = 0
'CALL VBDRAW(lh, uv, ag, qa, ta, dta$, H, v, B, swth, shht)

B = 1
'CALL VBDRAW(lh, uv, ag1, qa1, ta1, dta$, H1, V1, B, swth, shht)
 
  H = sh
  V = sv
  H1 = H: V1 = V

ta1 = ta
qa1 = qa
ag1 = ag

ke$ = INKEY$
LOOP UNTIL ke$ = CHR$(27)



END SUB

DEFSNG A-Z
SUB delay (tdelay!)
'talkhead
END SUB

SUB delete (DTA$)

LN = LEN(DTA$)
 CT = LN
 DO
 CT = CT - 1
 LN = LN - 1
 ch$ = MID$(DTA$, CT, 1)


LOOP UNTIL CT = 1 OR ch$ = ";"
IF LN > 2 THEN
PP$ = LEFT$(DTA$, LN)
DTA$ = PP$
END IF
END SUB

DEFINT A-Z
SUB DrawButton (posi)

X = Button(posi).X
Y = Button(posi).Y
lenght = Button(posi).lenght
TEXT$ = ButtonLabel$(posi)

LINE (X, Y)-(X + lenght, Y + 17), 9, BF
LINE (X, Y)-(X + lenght, Y + 17), 0, B
PAINT (X + 1, Y + 1), 7, 0

LINE (X, Y)-(X + lenght - 1, Y), 15
LINE (X, Y)-(X, Y + 16), 15

lenght = INT(lenght / 2)
Middle = INT(((LEN(TEXT$))) * 6.7)
Middle = INT(Middle / 2)
position = lenght - Middle


fprint TEXT$, X + position, Y + 3, 0, 2

END SUB

SUB DrawButtonDown (position)

posi = position
X = Button(posi).X
Y = Button(posi).Y
lenght = Button(posi).lenght
TEXT$ = ButtonLabel$(posi)

LINE (X, Y)-(X + lenght, Y + 17), 9, BF
LINE (X, Y)-(X + lenght - 1, Y + 16), 0, B
PAINT (X + 2, Y + 2), 7, 0

lenght = INT(lenght / 2)
Middle = INT(((LEN(TEXT$))) * 6.7)
Middle = INT(Middle / 2)
Positionn = lenght - Middle


fprint TEXT$, X + Positionn + 2, Y + 4, 0, 2




END SUB

SUB DrawListBox (posi)


X = ListBox(posi).X
Y = ListBox(posi).Y
XLEN = ListBox(posi).XLEN
YLEN = ListBox(posi).YLEN
TEXT$ = ListBoxLabel$(posi)
NumItems = ListBox(posi).NumItems
show = ListBox(posi).show
selected = ListBox(posi).selected
top = ListBox(posi).top


LINE (X, Y)-(X + XLEN, Y + YLEN), 0, B
LINE (X + 1, Y + 1)-(X + XLEN - 1, Y + YLEN - 1), 0, B

PAINT (X + 2, Y + 2), 15, 0
LINE (X, Y + YLEN)-(X + XLEN, Y + YLEN), 7
LINE (X + 1, Y + YLEN - 1)-(X + XLEN, Y + YLEN - 1), 7

LINE (X + XLEN, Y)-(X + XLEN, Y + YLEN), 7
LINE (X + XLEN - 1, Y + 1)-(X + XLEN - 1, Y + YLEN), 7



fprint TEXT$, X + 2, Y - 10, 0, 2


'Draw Arrow Buttons and Stuff
LINE (X + XLEN + 1, Y)-(X + XLEN + 13, Y + YLEN), 8, BF

LINE (X + XLEN + 5, Y + 10)-(X + XLEN + 8, Y + 15), 7, BF
LINE (X + XLEN + 2, Y + 10)-(X + XLEN + 7, Y + 5), 7
LINE (X + XLEN + 12, Y + 10)-(X + XLEN + 7, Y + 5), 7
LINE (X + XLEN + 2, Y + 10)-(X + XLEN + 12, Y + 10), 7

PAINT (X + XLEN + 7, Y + 7), 7, 7


LINE (X + XLEN + 5, Y + (YLEN - 10))-(X + XLEN + 8, Y + (YLEN - 15)), 7, BF
LINE (X + XLEN + 2, Y + (YLEN - 10))-(X + XLEN + 7, Y + (YLEN - 5)), 7
LINE (X + XLEN + 12, Y + (YLEN - 10))-(X + XLEN + 7, Y + (YLEN - 5)), 7
LINE (X + XLEN + 2, Y + (YLEN - 10))-(X + XLEN + 12, Y + (YLEN - 10)), 7

PAINT (X + XLEN + 7, Y + (YLEN - 7)), 7, 7




'Print Items On List Box

row = Y
row = row + 3
IF top = 1 THEN
 FOR ss = 1 TO NumItems
  fprint ListBoxContent$(posi, ss), X + 5, row, 0, 2
  row = row + 10
  IF show = ss THEN EXIT FOR
 NEXT ss
ELSE
 
 FOR ss = top TO NumItems
  fprint ListBoxContent$(posi, ss), X + 5, row, 0, 2
  row = row + 10
  IF show = ss THEN EXIT FOR
 NEXT ss
END IF



END SUB

SUB drawPointer


IF mpticon > 3 THEN mpticon = 0

SELECT CASE (mpticon)

CASE IS = 1 OR 0



CASE IS = 0

CC = INT(RND(1) * (16)) + 1

LINE (MOUSEH, MOUSEV)-(MOUSEH + si, MOUSEV + si), CC, BF
LINE (MOUSEH, MOUSEV)-(MOUSEH + si, MOUSEV + si), 2, B

CASE IS = 1



CASE IS = 2

CALL tmouse(mh, mv)


LOCATE mv, mh
 c = INT(RND(1) * (15)) + 1
'COLOR c
PRINT CHR$(219)

'COLOR 7
IF mh1 <> (mh) OR mv1 <> (mv) THEN
  'sec = 0
 
  LOCATE mv1, mh1
  PRINT Lstbgcw$;

mh1 = mh
mv1 = mv

 Lstbgcw$ = bgcw$

END IF


END SELECT
END SUB

SUB DRAWTEXTBOX (position)


X = TextBox(position).X
Y = TextBox(position).Y
lenght = TextBox(position).lenght
TEXT$ = TextBox(position).label



LINE (X, Y)-(X + lenght, Y + 17), 8, B
LINE (X + 1, Y + 1)-(X + lenght - 1, Y + 16), 8, B
PAINT (X + 2, Y + 2), 15, 8

LINE (X + 1, Y + 16)-(X + lenght - 1, Y + 16), 7
LINE (X, Y + 17)-(X + lenght, Y + 17), 7

LINE (X + lenght - 1, Y + 1)-(X + lenght - 1, Y + 16), 7
LINE (X + lenght, Y)-(X + lenght, Y + 17), 7


PrintLabel position, 0





END SUB

SUB DRAWWINDOWS

  DO
  LH = marry(tct, 0)
  UV = marry(tct, 1)
  mr = marry(tct, 2)
  mb = marry(tct, 4)
  mc = marry(tct, 5)
  DT = marry(tct, 6)
  ta = marry(tct, 7)' last cad positionf
 

  DTA$ = tmarry$(tct, 0)
  REM redraw Window
  CT = tct
 
  CALL pxwindow(LH, UV, mr, mb, mc, CT, DT, DTA$, ta)
 
  marry(tct, 7) = ta' update
    



    tct = tct + 1
  LOOP UNTIL tct >= (50)


END SUB

SUB exitroutine

REM Exit

 LOCATE 24, 1
 vv = 0

 DO
 PRINT
 vv = vv + 1

 wlength = 1
 CALL Pause(wlength)

 LOOP UNTIL vv >= 27


CLOSE #1
CLOSE #2

 
  SYSTEM
 
  END ' exit Routine
END SUB

SUB fixfna (filena$)

IF RIGHT$(filena$, 1) = " " THEN

ll = LEN(filena$)

IF ll > 1 THEN
frg$ = LEFT$(filena$, ll - 1)

filena$ = frg$
END IF
END IF


END SUB

SUB fopen (FILE$, FILE%)

  OPEN FILE$ FOR RANDOM AS FILE% LEN = 2
  'Just to make it easier for those of you who dont
  'understand the OPEN command yet! ;)

END SUB

SUB fprint (TEXT$, textx%, texty%, colour%, FILE%)

  'lpi: lines per integer
  'fws: font word spacing
  'fls: font letter spacing
  'p% : pointer
  GET FILE%, 1, lpi%
  GET FILE%, 2, fws%
  GET FILE%, 3, fls%
  FOR count% = 1 TO LEN(TEXT$)
    m% = ASC(MID$(TEXT$, count%, 1)) - 29
    IF m% > 3 THEN
      GET FILE%, m%, a1%
      GET FILE%, m% + 1, a2%
      FOR n% = a1% TO a2% - 1 STEP lpi%
        FOR z% = 0 TO lpi% - 1
          GET FILE%, n% + z%, L%
           LINE (p% + textx%, (16 * z%) + texty%)-(p% + textx%, (16 * z%) + 15 + texty%), colour%, , L%
        NEXT z%
        p% = p% + 1
      NEXT n%
      p% = p% + fls%
    ELSE
      p% = p% + fws%
    END IF
  NEXT count%




END SUB

DEFSNG A-Z
SUB getjoystick (di$)
j0 = STICK(0)
j1 = STICK(1)

j2 = STICK(2)
j3 = STICK(3)

LOCATE 10, 1
'PRINT j0, j1, 2, j3; "      "

IF j0 > 95 THEN di$ = "K"
IF j0 < 60 THEN di$ = "j"
IF j1 > 95 THEN di$ = "M"
IF j1 < 60 THEN di$ = "I"






END SUB

DEFINT A-Z
SUB GETTX (DTA$, CT, txt$, s)
TE = 0
DO
    Tte$ = MID$(DTA$, CT + TE, 1)
    TE = TE + 1
    LOOP UNTIL Tte$ = ","
    txt$ = MID$(DTA$, CT + 1, TE - 2)
    
    TS = CT + TE
    TT = 0
    DO
       TT = TT + 1
    Tte$ = MID$(DTA$, TS + TT, 1)
    LOOP UNTIL Tte$ = ";"
     
    s = VAL(MID$(DTA$, TS, TT))
  
CT = CT + (TT)
END SUB

SUB GETVL (DTA$, CT, sz)
LN = LEN(DTA$)
TE = 0
   
    IF (CT + TE) < (LN) THEN
    DO
    
    Tte$ = MID$(DTA$, CT + TE, 1)
    
    vTE = TE + 1
   ' PRINT TTE$;
    LOOP UNTIL Tte$ = ";" OR (CT + TE) > (LN)
   
      IF TE > 2 THEN
    sz = VAL(MID$(DTA$, CT + 1, TE - 2))
     END IF
    END IF
END SUB

SUB grabtext

gh = 1
gv = 2

FOR gv = 2 TO 23
 FOR gh = 1 TO 79
 w$ = CHR$(SCREEN(gv, gh))
 bgtext$ = bgtext$ + w$

 NEXT gh
 bgtext$ = bgtext$ + " "


NEXT gv


END SUB

SUB icons (H, V)




END SUB

SUB initmem
REM MEM SUB

'SCREEN 12

X = 300
Y = 100

' show important hardware stuff here

LOCATE 1, 15: PRINT "- PLEXER -"
CT = 0
'V = 10
DO

 mseg% = PEEK(CT)

 IF mseg% = 0 THEN
  capacity = capacity + 1
 END IF


LINE (0, 0)-(257, 400), 15, B
LINE (0, V)-(mseg%, V), 7
 
LINE -(255, V), 0
 
LINE (257, 0)-(260, V), 7, BF
LINE -(257, 400), 0, BF

  V = V + 1

 CT = CT + 1
    


  LINE (X, Y)-(X + 120, Y + 20), 7, B
  LINE (X + 1, Y + 1)-(X + (capacity / 255), Y + 19), 6, BF


IF V = 360 THEN
 
  
  V = 10
  TE$ = STR$(CT / 255)
  THP = thplim - 10: TVP = 1
  CALL TextPl(THP, TVP, TE$)
 
  TE$ = STR$(CT)
  TE$ = STR$(CT / 255)
   TVP = 2
  CALL TextPl(THP, TVP, TE$)
  


  ' 2, 15: PRINT "Hit <spacebar> "
  'LOCATE 3, 15: PRINT "MEMORY TEST CHECK "
  'LOCATE 4, 15: PRINT (capacity + 1) / 255
 
  'LOCATE 5, 15: PRINT "<esc> Exit"
    
     wlength = 2
  'CALL Pause(wlength)

END IF
ky$ = INKEY$
IF ke$ = CHR$(27) THEN CT = 32550

LOOP UNTIL ky$ = CHR$(27) OR CT >= 32550


 IF capacity < 60 THEN ms$ = "MEMory TOO LOW "
 IF capacity <= 70 THEN ms$ = "MEMory LOW you need to Exit"
 IF capacity > 80 THEN ms$ = "MEMory OK"
 IF capacity > 90 THEN ms$ = "MEMory ideal"


 LOCATE 10, 15
 PRINT ms$
 LOCATE 11, 15
 PRINT "DONE Hit <spacebar> "
 IF capacity < 60 THEN
    SLEEP
    END

 END IF


 SLEEP
END SUB

DEFSNG A-Z
SUB INItSCREEN
'ON ERROR GOTO Handler

BG:
ext = 0
DO
SCREEN scrn

ext = 1

LOOP UNTIL ext = 1


SELECT CASE (scrn)
 CASE IS = 1
 thplim = 40
  tvplim = 24

 CASE IS = 2
 thplim = 40
  tvplim = 24

 CASE IS = 3
 thplim = 79
  tvplim = 24

 CASE IS = 4
 thplim = 40
 tvplim = 24

 CASE IS = 7
 thplim = 40
 tvplim = 24
        
 CASE IS = 8
 thplim = 79
 tvplim = 24

 CASE IS = 9
 thplim = 40
 tvplim = 24


 CASE IS = 10
 thplim = 79
 tvplim = 24

 CASE IS = 11
 thplim = 79
 tvplim = 24

 CASE IS = 12
 thplim = 79
 tvplim = 29

 CASE IS = 13
 thplim = 40
 tvplim = 24



END SELECT

'ON ERROR GOTO LEAVE:

SCREEN scrn


5  PRINT " #screen "; scrn
SLEEP





END SUB

DEFINT A-Z
SUB IPxWindow (rsize, bsize, mc, CT, DTA$, DT)


DO

tvar = marry(CT, 2)

IF tvar <> 0 THEN
 CT = CT + 1
END IF
LOOP UNTIL tvar = 0 OR CT >= 100

marry(CT, 0) = MOUSEH:  marry(CT, 2) = MOUSEH + rsize
marry(CT, 1) = MOUSEV: marry(CT, 4) = MOUSEV + bsize
marry(CT, 5) = mc
marry(CT, 6) = DT
tmarry$(CT, 0) = DTA$


'LOCATE 24, 2
'PRINT ct

END SUB

DEFSNG A-Z
SUB ldsv (DTA$, CAD$, SE$)
     CLS
    
    
     PRINT "< "; CAD$; " > currently in cash"
     PRINT " ### What do you want to do ###"

     PRINT "load a cad file or save one"
     PRINT "saves to current directory"
   
    INPUT "<D>, <L> , <S>"; LS$
    LS$ = UCASE$(LS$)


    IF LS$ = "D" THEN
     DO
     FILES
     INPUT "dir >"; DR$

     IF DR$ <> "" THEN CHDIR DR$

     LOOP UNTIL DR$ = ""


    END IF


    IF LS$ = "L" THEN
    REM LOADING ALGORITHM
   
    PRINT "<.Cad> added automatically"
    PRINT
    
    FILES
    INPUT "NAME OF QBcad TO LOAD INTO  "; CAD$
     

     IF CAD$ <> "" THEN
      CLOSE #1
       
        PRINT "OPENING-"; CAD$
        OPEN CAD$ + ".cad" FOR INPUT AS #1
     
        LINE INPUT #1, DTA$
    
    CLOSE #1
     
     
     
     
ll = LEN(DTA$)

DO
CT = CT + 1
ch$ = MID$(DTA$, CT, 1)

LOOP UNTIL ch$ = "S" OR CT >= (ll)

DO
CT = CT + 1
ch$ = MID$(DTA$, CT, 1)

NN$ = NN$ + ch$

LOOP UNTIL ch$ = ";" OR CT >= (ll)

SE$ = MID$(NN$, 1, LEN(NN$) - 1)

     
     
     
      ELSE

      PRINT " LOAD ROUTINE ABORTED "
     
     
      END IF
   
    END IF


    IF LS$ = "S" THEN

    REM savinG ALGORITHM
  
    PRINT "<.Cad> added automatically"
    DO
    FILES
    INPUT "NAME OF QBcad TO be saved  "; cd1$
     IF cd1$ <> "" THEN CAD$ = cd1$
    
     IF cd1$ = "" THEN
     PRINT "would you like to replace "; CAD$
     INPUT "Y/N"; YN$
     YN$ = UCASE$(YN$)

     IF YN$ = "Y" THEN cd1$ = CAD$
     END IF
   
    LOOP UNTIL cd1$ <> ""
    
      CLOSE #1
      
        PRINT "OPENING-"; CAD$
       
        OPEN CAD$ + ".cad" FOR OUTPUT AS #1
     
        PRINT #1, DTA$
    
    CLOSE #1


    END IF

    PRINT "## done ## HIT ANY <KEY> "
      


     SLEEP
     CLS

    


END SUB

DEFINT A-Z
SUB MainIntro
 DO
 CLS
 LOCATE 1, 1

 PRINT "PLEXER opperating system Written by Scott Gates"
 PRINT "###############################################"
 PRINT "according to your system todays Date is "; DATE$
 PRINT "Function keys <F7> through <F12> change mouse  "
 PRINT " <F7> plexer mouse/ <F11> windows style mouse  "
 PRINT " <D12> Dos Mouse                               "
 PRINT "          "
 PRINT "READY# is your dos port uses Dos command"
 PRINT "<BYE> exits <sleep> runs screen Saver"
 PRINT " Password Routine  dissabled"
 PRINT "---------------------------------------------"
 PRINT " Welcome  <RUN> to open Plexer "
 PRINT "#############################################"



 INPUT "Command"; com$
 com$ = UCASE$(com$)

 IF com$ = "BYE" THEN END


 LOOP UNTIL com$ = "RUN"




END SUB

SUB mButton (nam, X, Y, lenght, label$)

pointer = 1
DO
 IF Button(pointer).nam <> 0 THEN
  pointer = pointer + 1
 END IF
LOOP UNTIL Button(pointer).nam = 0

ActiveButtons = ActiveButtons + 1
Button(pointer).nam = nam
Button(pointer).X = X
Button(pointer).Y = Y
Button(pointer).lenght = lenght
ButtonLabel$(pointer) = label$
DrawButton pointer



END SUB

SUB Menus (Ril, Bot, mh, mv, BU, ke$)

schr$ = CHR$(SCREEN(mv, mh))
' 20, 20
PRINT mh, mv, schr$
  
   REM ***
   REM fUNCTION kEYS
   REM ***
   
IF ke$ = CHR$(0) + "P" THEN qa = qa + 1: IF qa > 6 THEN qa = -6
IF ke$ = CHR$(0) + "H" THEN qa = qa - 1: IF qa < -6 THEN qa = 6
IF ke$ = CHR$(0) + "M" THEN ta = ta + 5
IF ke$ = CHR$(0) + "K" THEN ta = ta - 5


  IF BU = 3 THEN
    mpticon = mpticon + 1
    '
    SOUND 100, 3
    CALL wamouse

  END IF

IF BU = 1 THEN SOUND 120, 3

IF mpticon = 2 THEN
                     REM Check text
  IF BU = 1 THEN ke$ = CHR$(0) + CHR$(63) ' open filename

END IF



 SELECT CASE ke$
 CASE IS = CHR$(0) + CHR$(65)
    mpticon = 0

 


 CASE IS = CHR$(0) + CHR$(68)

 na$ = "c:\qbasic\audiomon.bas"
 OScall (na$)

 CASE IS = CHR$(0) + ";"
  'ct = ct + 1
  schr$ = "F": BU = 1
  
 CASE IS = CHR$(0) + CHR$(60)
     CT = CT + 1
    
     rsize = 160
     marry(tct, 3) = 0
     bsize = 160
    
     mc = 8' set color
     DT = 1'SET TO CAD
    
     DTA$ = "S1;C2;L 5;U 5;U 5;R 5;R 5;D 5;D 5;D 5;L 5;L 5;L 5;Z 5;Z 5;Z 5;Z 5;Z 5;Z 5;Z 5;Z 5;Z 5;R 5;R 5;R 5;U 5;U 5;U 5;L 5;L 5;L 5;L 5;L 5;L 5;D 5;D 5;D 5;D 5;D 5;D 5;R 5;R 5;R 5;R 5;R 5;R 5;R 5;R 5;R 5;R 5;R 5; "
     CALL IPxWindow(rsize, bsize, mc, CT, DTA$, DT)

     

 CASE IS = CHR$(0) + CHR$(61)
     'ct = ct + 1
     rsize = 160
     marry(tct, 3) = 0
     bsize = 160
   
     mc = 8' set color
     tct = CT
     marry(tct, 6) = 2 ' SET TO TIME
   
     CALL IPxWindow(rsize, bsize, mc, CT, DTA$, DT)

     
     CALL DRAWWINDOWS
     
 CASE IS = CHR$(0) + CHR$(62)
    
     rsize = 160
     marry(tct, 3) = 0
     bsize = 160
     'ct = ct + 1
     mc = 1' set color
     tct = CT
     marry(tct, 6) = 3 ' SET TO Demo
     CALL IPxWindow(rsize, bsize, mc, CT, DTA$, DT)

     
     CALL DRAWWINDOWS
     

 CASE IS = CHR$(0) + CHR$(63) ' F8

 LOCATE mv1, mh1: PRINT Lstbgcw$;



 LOCATE 10, 10
 PRINT "  <"; filena$; "> # "

 filena$ = UCASE$(filena$)

 CALL fixfna(filena$)

 sv$ = RIGHT$(filena$, 4)

 IF sv$ = ".BAS" OR sv$ = ".EXE" OR sv$ = ".BAT" THEN
  CALL Qbprun(filena$)
 END IF

 CALL openfile(mh, mv)

CASE IS = CHR$(0) + CHR$(66)
REM TYPE File
  


 filena$ = UCASE$(filena$)


 sv$ = RIGHT$(filena$, 4)

 
 
  CALL Qbprun(filena$)

 

  
  
   CALL cleartxt
   LOCATE 2, 1
  
   'PRINT STRING$(79, CHR$(205))
   CALL typef

CASE IS = CHR$(0) + CHR$(68)' <F10)
    

         w$ = "hi"

       'CALL PLsay(w$)





CASE IS = CHR$(0) + CHR$(133)' <F11)
        'CALL MOUSEPOINTER(0)      'Reset mouse and
        'CALL MOUSEPOINTER(1)      'show arrow
        'CALL MOUSEPOINTER(3)      'Get coordinates
        mpticon = 1' set to arrow
        LOCATE mv1, mh1
        PRINT Lstbgcw$;

 CASE IS = CHR$(0) + CHR$(134)' <F12>
         mpticon = 1
         REM hide arrow
        'CALL MOUSEPOINTER(0)      'Reset mouse and
        'CALL MOUSEPOINTER(2)      'show arrow
        'CALL MOUSEPOINTER(3)      'Get coordinates

        mpticon = 2' set to text

 CASE IS = CHR$(0) + CHR$(137)

 hidew = 0

 CASE IS = CHR$(0) + CHR$(138)

 hidew = 1
 CALL pastebgtext


 END SELECT
IF BU = 1 THEN
SELECT CASE schr$

CASE IS = "F"
 mc = 3
 LH = 0: UV = 20
 mr = 160
 mb = UV + 160
    rsize = LH + 160
    bsize = mb + 160
     pxwct = CT
     tmarry$(pxwct, 0) = "FILE"
  CALL pxwindow(LH, UV, mr, mb, mc, CT, DT, DTA$, ta)
  MOUSEV = 20
  CALL IPxWindow(rsize, bsize, mc, CT, DTA$, DT)
  CALL wamouse
END SELECT
END IF



  tct = 0
 
  DO
  LH = marry(tct, 0)
  UV = marry(tct, 1)
  mr = marry(tct, 2)
  mb = marry(tct, 4)
  mc = marry(tct, 5)
     CALL mouse(MCX, MDX, BX): BU = BX
      CX = MCX
      DX = MDX
    REM redraw Window
    IF MOUSEH > (LH) AND MOUSEH < (mr) AND MOUSEV > (UV) AND MOUSEV < (mb) THEN
     

      IF MDX <> (MOUSEH) OR MCX <> (MOUSEV) THEN
      CT = tct
     CALL pxwindow(LH, UV, mr, mb, mc, CT, DT, DTA$, ta)
      END IF


     'LOCATE 24, 3
     'REM window index
     'PRINT tct; " #"
    
    
     IF BU = 1 AND MOUSEH > (LH) AND MOUSEH < (LH + 10) AND MOUSEV > (UV) AND MOUSEV < (UV + 10) THEN
    
     mwct = tct
     rsize = (mr - LH)
     bsize = (mb - UV)
     CALL movewindow(mwct, rsize, bsize)
    
     END IF
    
    
     IF BU = 1 AND (MOUSEH + si) < (mr) AND MOUSEV > (UV) AND (MOUSEH + si) > (mr - 10) AND MOUSEV < (UV + 10) THEN
       
          mc = 0
          MOUSEH = 0
          MOUSEV = 0
          mouseh1 = 360 - si
          mousev1 = 200 - si
         'CLS
         ' CALL umouse(cx, dx, bx, bu)
         CT = tct
         CALL pxwindow(LH - 20, UV - 20, mr + 20, mb + 20, mc, CT, DT, DTA$, ta)
        

     marry(tct, 0) = 0
     marry(tct, 1) = 0
     marry(tct, 2) = 0
     marry(tct, 3) = 0
     marry(tct, 4) = 0
     marry(tct, 5) = 0
     marry(tct, 6) = 0
    
         CALL pastebgtext
         
     END IF


    END IF



    tct = tct + 1
  LOOP UNTIL tct >= (50)
    END SUB

SUB mListBox (nam, X, Y, XLEN, YLEN, label$)


pointer = 1
DO
 IF ListBox(pointer).nam <> 0 THEN
  pointer = pointer + 1
 END IF
LOOP UNTIL ListBox(pointer).nam = 0

ActiveListBoxes = ActiveListBoxes + 1
ListBox(pointer).nam = nam
ListBox(pointer).X = X
ListBox(pointer).Y = Y
ListBox(pointer).XLEN = XLEN
ListBox(pointer).YLEN = YLEN
ListBox(pointer).show = (INT(YLEN \ 10)) - 1
ListBox(pointer).top = 1
ListBox(pointer).scrollspeed = ListBoxScrollingSpeed
ListBox(pointer).speedcounter = 0
ListBoxLabel$(pointer) = label$
ListBox(pointer).redraw = 0
SelectedLine(pointer) = 1
DrawListBox pointer





END SUB

SUB mouse (MCX, MDX, BX)
      
     
           CALL XMOUSE(3)





             IF mouseleftbutton = -1 THEN BX = 1
             IF mouserightbutton = -1 THEN BX = 2
 IF mouseleftbutton = -1 AND mouserightbutton = -1 THEN BX = 3

 MOUSEH = MDX
 MOUSEV = MCX

IF MDX <> (mouseh1) OR MCX <> (mousev1) THEN

 sec = 0

 mouseh1 = MDX
 mousev1 = MCX

END IF
    

END SUB

SUB mouseButtons (CT, BU)


CALL mouse(MCX, MDX, BX)


CX = MCX
DX = MDX
X = MCX
Y = MDX
BU = BX

SELECT CASE (BU)

CASE IS = 1
    CALL icons(H%, V%)


   


CASE IS = 2
 
CALL wamouse

  LH = MOUSEH
  UV = MOUSEV
  mr = LH + 160
  mb = UV + 160
  mc = 15
  DT = 1
CALL pxwindow(LH, UV, mr, mb, mc, CT, DT, DTA$, ta)

  rsize = 160
  bsize = 160


IF CT > 100 THEN CT = 1
      mc = 7
      DT = 7
     pxwct = CT
     'tmarry$(pxwct, 0) = "HELP"
     SOUND 200, 3

CALL IPxWindow(rsize, bsize, mc, CT, DTA$, DT)

  'MTextBox 0, X + 3, Y + 12, 100, DATE$


 CALL wamouse


END SELECT




END SUB

SUB MOUSEPOINTER (SW)
       
           'POKE VARPTR(a(0)) + 1, SW         'Swap code,Set AX = (SW)
          'CALL absolute(c, VARPTR(a(0)))     'Run Code

                                          'Note:
                                             'SW = 0-reset
                                             'SW = 1-on
                                             'SW = 2-off
                                             'SW = 3-coordinates


END SUB

SUB movewindow (mwct, rsize, bsize)
DO
'CALL xmouse(3)

CALL mouse(MCX, MDX, BX)
BU = BX


H = MDX
V = MCX

LINE (H, V)-(H + rsize, V + bsize), 1, B

IF H <> (H1) OR V <> (V1) THEN
 LINE (H1, V1)-(H1 + rsize, V1 + bsize), 0, B
 
 H1 = H
 V1 = V

END IF


LOOP UNTIL BU = 0

  REM put new position in Array
 marry(mwct, 0) = H
 marry(mwct, 1) = V
 marry(mwct, 2) = H + rsize
 marry(mwct, 4) = V + bsize

 X = H: Y = V
 'MTextBox 0, X + 3, Y + 12, 100, DATE$



    CALL pastebgtext
    'SHELL "cls"
        'CALL MOUSEPOINTER(0)      'Reset mouse and
        'CALL mousepointer(1)      'show arrow
        'CALL mousepointer(3)      'Get coordinates
   
    'PUT (0, 20), BGPicture
END SUB

SUB MTextBox (nam, X, Y, lenght, label$)

pointer = 1
'DO
' IF TextBox(pointer).nam <> 0 THEN
'  pointer = pointer + 1
' END IF
'LOOP UNTIL TextBox(pointer).nam = 0

ActiveTextBoxes = ActiveTextBoxes + 1
TextBox(pointer).nam = nam
TextBox(pointer).X = X
TextBox(pointer).Y = Y
TextBox(pointer).lenght = lenght
TextBox(pointer).label = label$
TextBox(pointer).maxtext = INT(lenght / 8)
DRAWTEXTBOX pointer


END SUB

SUB openfile (mh, mv)

CALL tmouse(mh, mv)
' 2, 1
'PRINT mh, mv


IF mh < 1 THEN mh = 1

DO

w$ = CHR$(SCREEN(mv, mh))
      

na$ = na$ + w$
mh = mh + 1

LOOP UNTIL mh > 79 OR w$ = " "



LOCATE 2, 15
PRINT "<  "; na$; "  >"


filena$ = na$

END SUB

DEFSNG A-Z
SUB OScall (na$)



RUN na$
END SUB

DEFINT A-Z
SUB parkmouse

         MOUSEH = 10
         MOUSEV = 10
       
         GET (MOUSEH, MOUSEV)-(MOUSEH + si, MOUSEV + si), box%
         mouseh1 = MOUSEH: mousev1 = MOUSEV

END SUB

SUB pastebgtext


LOCATE 2, 1
PRINT bgtext$;



END SUB

SUB Pause (wlength)

 DIM tmp%(50, 20)
GET (0, 0)-(50, 20), tmp%

mpb = 0

DO
pb = pb + 1

 DO
 c = INT(RND(1) * (15)) + 1
' COLOR c
 LOCATE 1, 1
  PRINT "P" + TIME$
 
 LOOP UNTIL TIME$ <> (ltime$)
  ltime$ = TIME$
  mpb = mpb + 1

ke$ = INKEY$
LOOP UNTIL ke$ = CHR$(32) OR mpb >= (wlength)
  
PUT (0, 0), tmp%
 ' COLOR 7


END SUB

DEFSNG A-Z
SUB PDLINE (ag, VR, EA, DMO, H, V, X, Y, c, size, swth, shht)

ai = 1
'ADG = AG * 3.142857 / 180
ai = ai * 3.142857 / 180
FOR AAG = 1 TO (ADG) STEP (ai)
NEXT AAG
V1 = V + ((DMO * (VR)) / 6) * size
H1 = H


X = H1
Y = V1

H = X
V = Y

END SUB

SUB percad (nm$, DTA$, CAD$)
 INPUT "DO YOU WANT TO SEE THE DATA <Y/N> "; YN$: YN$ = UCASE$(YN$)
 X1 = 0: Y1 = 0: z1 = 0
 swth = 0: shht = 0

CT = 1
LN = LEN(DTA$)


OPEN nm$ + ".PCD" FOR OUTPUT AS #1

DO

DO
KC$ = MID$(DTA$, CT, 1)
CT = CT + 1
WORD$ = WORD$ + KC$

LOOP UNTIL KC$ = ";" OR CT >= (LN)
   'PRINT word$
 
   SL$ = MID$(WORD$, 2, 1)
   KC1$ = LEFT$(WORD$, 1)

 
  
   CNTL$ = LEFT$(WORD$, 1)
 CNTL$ = UCASE$(CNTL$)
 

REM IF ITS AN ANGLED MOVE BUILD THE CNTL$

   IF CNTL$ = "^" OR CNTL$ = "V" THEN
    CNTL$ = LEFT$(WORD$, 2)
   END IF

 n$ = MID$(WORD$, 2, LN - 1)
 n = VAL(n$): ' PRINT N$

 IF KC1$ = "^" OR KC1$ = "V" THEN
    n$ = ""
    ch$ = ""
    LW = LEN(WORD$)
  
     bdn = 2
   
     WHILE ch$ <> ";" AND bdn < LEN(WORD$)
     bdn = bdn + 1
     ch$ = MID$(WORD$, bdn, 1)
    
      IF ch$ <> ";" THEN
       n$ = n$ + ch$
      END IF
   
     WEND
   

   'PRINT "^V "; N$; " ### "
  
    n = VAL(n$): ' PRINT N$
   
 END IF
 IF CNTL$ = "C" THEN

  c = n

 END IF

 IF CNTL$ = "U" THEN Y1 = Y1 - n: PD = 1
 IF CNTL$ = "D" THEN Y1 = Y1 + n: PD = 1
 IF CNTL$ = "R" THEN X1 = X1 + n: PD = 1
 IF CNTL$ = "L" THEN X1 = X1 - n: PD = 1
 IF CNTL$ = "Z" THEN z1 = z1 - n: PD = 1: REM f
 IF CNTL$ = "X" THEN z1 = z1 + n: PD = 1: REM b

 IF CNTL$ = "E" THEN
  PD = 1
  X1 = X1 + n: Y1 = Y1 - n
 END IF
 IF CNTL$ = "H" THEN
  PD = 1
  X1 = X1 - n: Y1 = Y1 - n
 END IF
 IF CNTL$ = "F" THEN
 PD = 1
 X1 = X1 + n: Y1 = Y1 + n
 END IF
 IF CNTL$ = "G" THEN
 PD = 1
 X1 = X1 - n: Y1 = Y1 + n
 END IF



 IF CNTL$ = "^R" THEN
 PD = 1
 X1 = X1 + n: z1 = z1 - n
 END IF

 IF CNTL$ = "^D" THEN
 PD = 1
 Y1 = Y1 + n: z1 = z1 - n
 END IF

 IF CNTL$ = "^L" THEN
 PD = 1
 X1 = X1 - n: z1 = z1 - n
 END IF

 IF CNTL$ = "^U" THEN
 PD = 1
 Y1 = Y1 - n: z1 = z1 - n
 END IF

 IF CNTL$ = "VR" THEN
 PD = 1
 X1 = X1 + n: z1 = z1 + n
 END IF
 IF CNTL$ = "VD" THEN
 PD = 1
 Y1 = Y1 + n: z1 = z1 + n
 END IF

 IF CNTL$ = "VL" THEN
 PD = 1
 X1 = X1 - n: z1 = z1 + n
 END IF

 IF CNTL$ = "VU" THEN
 PD = 1
 Y1 = Y1 - n: z1 = z1 + n
 END IF

 IF CNTL$ = "^E" THEN
 PD = 1
 Y1 = Y1 - n: X1 = X1 + n: z1 = z1 - n
 END IF

 IF CNTL$ = "^F" THEN
 PD = 1
 Y1 = Y1 + n: X1 = X1 + n: z1 = z1 - n
 END IF

 IF CNTL$ = "^G" THEN
 PD = 1
 Y1 = Y1 + n: X1 = X1 - n: z1 = z1 - n
 END IF

 IF CNTL$ = "^H" THEN
 PD = 1
 Y1 = Y1 - n: X1 = X1 - n: z1 = z1 - n
 END IF

 IF CNTL$ = "VE" THEN
 PD = 1
 Y1 = Y1 - n: X1 = X1 + n: z1 = z1 + n
 END IF

 IF CNTL$ = "VF" THEN
 PD = 1
 Y1 = Y1 + n: X1 = X1 + n: z1 = z1 + n
 END IF

 IF CNTL$ = "VG" THEN
 PD = 1
 Y1 = Y1 + n: X1 = X1 - n: z1 = z1 + n
 END IF

 IF CNTL$ = "VH" THEN
 PD = 1
 Y1 = Y1 - n: X1 = X1 - n: z1 = z1 + n
 END IF



 IF lword$ <> "B;" AND PD = 1 THEN
 PRINT #1, x2; ";"; y2; ";"; z2; ";"; X1; ";"; Y1; ";"; z1; ";"; c; ";"; CHR$(13)

 IF YN$ = "Y" THEN
  PRINT x2; ";"; y2; ";"; z2; ";"; X1; ";"; Y1; ";"; z1; ";"; c; ";"; CHR$(13)
  END IF

 PD = 0


 END IF


   x2 = X1
   y2 = Y1
   z2 = z1


 IF tp = 2 THEN
 tp = 0
END IF
 lword$ = WORD$
 WORD$ = ""
LOOP UNTIL CT >= (LN)
CLOSE #1

PRINT nm$; " SAVED #"
SLEEP

END SUB

DEFINT A-Z
FUNCTION piqa



  piqa = (piqa) * 3.14 / 180


END FUNCTION

SUB PlayWarning


SOUND 600, .05
SOUND 700, .05


END SUB

SUB Plexer (DTXT$)
 REM Special Plexer commands
 REM

 SELECT CASE (DTXT$)

 CASE IS = "-PLEXER"
  SYSTEM
 CASE IS = "SLEEP"
 CALL scrnsaver
   DTXT$ = ""
   
 CASE IS = "BYE"
  proglock$ = "False"
    CALL exitroutine
 CASE IS = "SAY"

 na$ = "c:\qbasic\audiomon.bas"
 OScall (na$)
 



 END SELECT


END SUB

SUB pline (ag, VR, EA, ANGLE, sz, X, Y, H, V, c, size, swth, shht)

'REM EA IS VERTICAL ANGLE
'VR IS HOROZONTAL ANGLE
' AG IF FRONTAL ANGLE
'If AG = 0 Then AG = 1
IF VR = 0 THEN VR = 1
  cl = 0
  ai = 5
  ai = ai * 3.142857 / 180
   EA = EA * 3.142857 / 180
  
   FOR TR = (ANGLE) TO (ANGLE + EA) STEP ai
  
   NEXT TR
'agc = AG * 3.142857 / 180

FOR ATR = (ai) TO (ai + agc) STEP ai
NEXT ATR

DO
  'AGD = AG * 3.142857 / 180
  cl = cl + sz
  X = H + (cl * size) * COS(TR)
  Y = V + (cl * size) * SIN(TR) / VR '* ATR

LOOP UNTIL (cl) >= (sz * scale)



H = X: V = Y
END SUB

DEFSNG A-Z
SUB portdta (DTA$, CAD$)
CLS
PRINT
PRINT "**********************"
PRINT "* CONVERTING CAD DATA*"
PRINT "**********************"
PRINT
PRINT "CURRENT    "; CAD$
INPUT "File name  ", nm$

IF nm$ = "" THEN nm$ = CAD$

PRINT "<1> for DANCAD3D 1.0 "
PRINT "<2> for PERCAD 2000  "
PRINT ""
PRINT ""

INPUT ke

SELECT CASE ke
CASE 1
 INPUT "DO YOU WANT TO SEE THE DATA <Y/N> "; YN$: YN$ = UCASE$(YN$)
 X1 = 0: Y1 = 0: z1 = 0
 swth = 0: shht = 0

CT = 1
LN = LEN(DTA$)

     CHDIR "C:\DANCAD3D"
OPEN nm$ FOR OUTPUT AS #1

PRINT #1, "DATA AS X1 Y1 Z1 X2 Y2 Z2, 0 0 0  0 0 0 ENDS FILE:"; nm$

DO

DO
KC$ = MID$(DTA$, CT, 1)
CT = CT + 1
WORD$ = WORD$ + KC$

LOOP UNTIL KC$ = ";" OR CT >= (LN)
   'PRINT word$
  
   SL$ = MID$(WORD$, 2, 1)
   KC1$ = LEFT$(WORD$, 1)

  
   
   CNTL$ = LEFT$(WORD$, 1)
 CNTL$ = UCASE$(CNTL$)
  

REM IF ITS AN ANGLED MOVE BUILD THE CNTL$

   IF CNTL$ = "^" OR CNTL$ = "V" THEN
    CNTL$ = LEFT$(WORD$, 2)
   END IF

 n$ = MID$(WORD$, 2, LN - 1)
 n = VAL(n$): ' PRINT N$

 IF KC1$ = "^" OR KC1$ = "V" THEN
    n$ = ""
    ch$ = ""
    LW = LEN(WORD$)
   
     bdn = 2
    
     WHILE ch$ <> ";"
     bdn = bdn + 1
     ch$ = MID$(WORD$, bdn, 1)
     
      IF ch$ <> ";" THEN
       n$ = n$ + ch$
      END IF
    
     WEND
    

   'PRINT "^V "; N$; " ### "
   
    n = VAL(n$): ' PRINT N$
    
 END IF


 IF CNTL$ = "U" THEN Y1 = Y1 - n: PD = 1
 IF CNTL$ = "D" THEN Y1 = Y1 + n: PD = 1
 IF CNTL$ = "R" THEN X1 = X1 + n: PD = 1
 IF CNTL$ = "L" THEN X1 = X1 - n: PD = 1
 IF CNTL$ = "Z" THEN z1 = z1 - n: PD = 1: REM f
 IF CNTL$ = "X" THEN z1 = z1 + n: PD = 1: REM b

 IF CNTL$ = "E" THEN
  PD = 1
  X1 = X1 + n: Y1 = Y1 - n
 END IF
 IF CNTL$ = "H" THEN
  PD = 1
  X1 = X1 - n: Y1 = Y1 - n
 END IF
 IF CNTL$ = "F" THEN
 PD = 1
 X1 = X1 + n: Y1 = Y1 + n
 END IF
 IF CNTL$ = "G" THEN
 PD = 1
 X1 = X1 - n: Y1 = Y1 + n
 END IF



 IF CNTL$ = "^R" THEN
 PD = 1
 X1 = X1 + n: z1 = z1 - n
 END IF

 IF CNTL$ = "^D" THEN
 PD = 1
 Y1 = Y1 + n: z1 = z1 - n
 END IF

 IF CNTL$ = "^L" THEN
 PD = 1
 X1 = X1 - n: z1 = z1 - n
 END IF

 IF CNTL$ = "^U" THEN
 PD = 1
 Y1 = Y1 - n: z1 = z1 - n
 END IF

 IF CNTL$ = "VR" THEN
 PD = 1
 X1 = X1 + n: z1 = z1 + n
 END IF
 IF CNTL$ = "VD" THEN
 PD = 1
 Y1 = Y1 + n: z1 = z1 + n
 END IF

 IF CNTL$ = "VL" THEN
 PD = 1
 X1 = X1 - n: z1 = z1 + n
 END IF

 IF CNTL$ = "VU" THEN
 PD = 1
 Y1 = Y1 - n: z1 = z1 + n
 END IF

 IF CNTL$ = "^E" THEN
 PD = 1
 Y1 = Y1 - n: X1 = X1 + n: z1 = z1 - n
 END IF

 IF CNTL$ = "^F" THEN
 PD = 1
 Y1 = Y1 + n: X1 = X1 + n: z1 = z1 - n
 END IF

 IF CNTL$ = "^G" THEN
 PD = 1
 Y1 = Y1 + n: X1 = X1 - n: z1 = z1 - n
 END IF
 
 IF CNTL$ = "^H" THEN
 PD = 1
 Y1 = Y1 - n: X1 = X1 - n: z1 = z1 - n
 END IF

 IF CNTL$ = "VE" THEN
 PD = 1
 Y1 = Y1 - n: X1 = X1 + n: z1 = z1 + n
 END IF

 IF CNTL$ = "VF" THEN
 PD = 1
 Y1 = Y1 + n: X1 = X1 + n: z1 = z1 + n
 END IF

 IF CNTL$ = "VG" THEN
 PD = 1
 Y1 = Y1 + n: X1 = X1 - n: z1 = z1 + n
 END IF

 IF CNTL$ = "VH" THEN
 PD = 1
 Y1 = Y1 - n: X1 = X1 - n: z1 = z1 + n
 END IF

 

 IF lword$ <> "B;" AND PD = 1 THEN
 PRINT #1, x2; " "; y2; " "; z2; " "; X1; " "; Y1; " "; z1; " "; CHR$(13)

 IF YN$ = "Y" THEN
  PRINT WORD$; " to "; x2; " "; y2; " "; z2; " "; X1; " "; Y1; " "; z1; " "; "SZ "; n; CHR$(13)
 END IF

 PD = 0


 END IF
 

   x2 = X1
   y2 = Y1
   z2 = z1

 
 IF tp = 2 THEN
 tp = 0
END IF
 lword$ = WORD$
 WORD$ = ""
LOOP UNTIL CT >= (LN)

PRINT #1, "0 0 0  0 0 0"
CLOSE #1

PRINT nm$; " SAVED #"
SLEEP
 ' DANCAD3D
CASE 2
CALL percad(nm$, DTA$, CAD$)

END SELECT
CLS
END SUB

DEFINT A-Z
SUB PrintButtonLabel (ButtonNum, clr)


X = Button(posi).X
Y = Button(posi).Y
lenght = Button(posi).lenght
TEXT$ = ButtonLabel$(posi)

lenght = INT(lenght / 2)
Middle = INT(((LEN(TEXT$))) * 6.7)
Middle = INT(Middle / 2)
position = lenght - Middle


fprint TEXT$, X + position, Y + 3, clr, 2


END SUB

SUB PrintLabel (TextBoxNum, clr)

IF ActiveTextBoxes <> 0 THEN
 X = TextBoxNum
 TEXT$ = TextBox(X).label
 fprint TEXT$, TextBox(X).X + 2, TextBox(X).Y - 10, clr, 2
END IF

END SUB

SUB prtext (txt$, H, V, s, c, mr, mb)
hh = H: vv = V
sz = s
vvv = 0
hh = hh + sz

IF H > 0 AND H < (Ril) AND V > 0 AND V < (Bot) THEN

FOR CT = 1 TO LEN(txt$)
ch$ = MID$(txt$, CT, 1)
IF ch$ = CHR$(32) THEN
hh = hh + (sz * 6)
END IF

IF hh > (mr - (sz * 6)) THEN
   hh = H
   V = V + 10

END IF


IF ch$ = "#" THEN
hh = H
vvv = vvv + (sz * 8)
END IF
IF ch$ = "A" THEN
CALL VBCH("U;U;U;U;U;E;R;G;D;D;L;L;L;R;R;R;D;D;D;D;", hh, vv, sz, c)
hh = hh + (sz * 6)
END IF
IF ch$ = "B" THEN
CALL VBCH("U;U;U;U;U;U;R;R;G;D;F;L;R;G;D;F;L;L;", hh, vv, sz, c)
hh = hh + (sz * 6)
END IF
IF ch$ = "C" THEN
CALL VBCH("R;R;R;R;L;L;L;L;U;U;U;U;U;U;R;R;R;R;", hh, vv, sz, c)
hh = hh + (sz * 6)
END IF
IF ch$ = "D" THEN
CALL VBCH("R;R;R;L;L;L;U;U;U;U;U;U;R;R;R;G;D;D;D;D;F;", hh, vv, sz, c)
hh = hh + (sz * 6)
END IF
IF ch$ = "E" THEN
CALL VBCH("R;R;R;R;L;L;L;L;U;U;U;R;R;R;L;L;L;U;U;U;R;R;R;R;", hh, vv, sz, c)
hh = hh + (sz * 6)
END IF
IF ch$ = "F" THEN
CALL VBCH("U;U;U;R;R;R;L;L;L;U;U;U;R;R;R;R;", hh, vv, sz, c)
hh = hh + (sz * 6)
END IF
IF ch$ = "G" THEN
CALL VBCH("R;R;R;U;U;L;L;R;R;D;D;L;L;L;U;U;U;U;U;E;R;G;D;", hh, vv, sz, c)
hh = hh + (sz * 6)
END IF

IF ch$ = "H" THEN
CALL VBCH("U;U;U;U;U;U;D;D;D;R;R;R;U;U;U;D;D;D;D;D;D;", hh, vv, sz, c)
hh = hh + (sz * 6)
END IF

IF ch$ = "I" THEN
CALL VBCH("R;R;R;L;U;U;U;U;U;U;L;R;R;R;", hh, vv, sz, c)
hh = hh + (sz * 6)
END IF
IF ch$ = "J" THEN
CALL VBCH("U;D;R;R;R;U;U;U;U;U;U;", hh, vv, sz, c)
hh = hh + (sz * 6)
END IF
IF ch$ = "K" THEN
CALL VBCH("U;U;U;U;U;U;D;D;DR;E;E;E;F;F;F;G;G;G;", hh, vv, sz, c)
hh = hh + (sz * 6)
END IF
IF ch$ = "L" THEN
CALL VBCH("R;R;R;R;L;L;L;L;U;U;U;U;U;U;", hh, vv, sz, c)
hh = hh + (sz * 6)
END IF
IF ch$ = "M" THEN
CALL VBCH("U;U;U;U;U;U;G;G;G;E;E;E;D;D;D;D;D;D;", hh, vv, sz, c)
hh = hh + (sz * 6)
END IF
IF ch$ = "N" THEN
CALL VBCH("U;U;U;U;U;U;G;G;G;U;U;U;D;D;D;D;D;D;", hh, vv, sz, c)
hh = hh + (sz * 6)
END IF

IF ch$ = "O" THEN
CALL VBCH("U;U;U;U;U;U;R;R;R;R;D;D;D;D;D;D;L;L;L;L;", hh, vv, sz, c)
hh = hh + (sz * 6)
END IF
IF ch$ = "P" THEN
CALL VBCH("U;U;U;U;U;U;R;R;R;R;D;D;D;D;L;L;L;L;", hh, vv, sz, c)
hh = hh + (sz * 6)
END IF

IF ch$ = "Q" THEN
CALL VBCH("U;U;U;U;U;U;R;R;R;R;D;D;D;D;D;D;H;G;G;H;L;L;L;L;", hh, vv, sz, c)
hh = hh + (sz * 6)
END IF
IF ch$ = "R" THEN
CALL VBCH("U;U;U;U;U;U;R;R;R;G;D;F;L;L;R;R;G;D;D;", hh, vv, sz, c)
hh = hh + (sz * 6)
END IF

IF ch$ = "S" THEN
CALL VBCH("R;R;R;E;U;H;L;H;U;E;R;R;R;", hh, vv, sz, c)
hh = hh + (sz * 6)
END IF

IF ch$ = "T" THEN
hh = hh + (sz * 2)
CALL VBCH("U;U;U;U;U;U;R;R;L;L;L;L;", hh, vv, sz, c)
hh = hh + (sz * 4)
END IF
IF ch$ = "U" THEN
CALL VBCH("U;U;U;U;U;U;D;D;D;D;D;D;R;R;R;R;U;U;U;U;U;U;", hh, vv, sz, c)
hh = hh + (sz * 6)
END IF
IF ch$ = "V" THEN
vv = vv - (sz * 6)
CALL VBCH("D;D;D;G;G;G;E;E;E;U;U;U;", hh, vv, sz, c)
hh = hh + (sz * 6)
END IF
IF ch$ = "W" THEN
vv = vv - (sz * 6)
CALL VBCH("D;D;D;D;G;G;E;E;U;D;G;G;E;E;U;U;U;U;", hh, vv, sz, c)
hh = hh + (sz * 12)
END IF
IF ch$ = "X" THEN
vv = vv - (sz * 6)
CALL VBCH("G;G;G;G;G;G;H;H;H;E;E;E;F;F;F;F;F;F;", hh, vv, sz, c)
hh = hh + (sz * 6)
END IF


IF ch$ = "Y" THEN
vv = vv - (sz * 6)
CALL VBCH("G;G;G;E;E;E;F;F;F;D;D;D;", hh, vv, sz, c)
hh = hh + (sz * 6)
END IF

IF ch$ = "Z" THEN
vv = vv - (sz * 6)
CALL VBCH("R;R;R;R;R;R;F;F;F;F;F;F;R;R;R;R;R;R;", hh, vv, sz, c)
hh = hh + (sz * 6)
END IF
vv = V + vvv
NEXT CT
END IF
END SUB

SUB PutCharOnBox (result$)

IF ActiveTextBoxes <> 0 THEN
 TEXT$ = TextBoxResult$(TextBoxFocus)
 L = LEN(TEXT$)


 IF CHR$(8) = result$ THEN
  IF L = 0 THEN
  ELSE
   fprint TEXT$, TextBox(TextBoxFocus).X + 4, TextBox(TextBoxFocus).Y, 15, 1
   TEXT$ = LEFT$(TEXT$, L - 1)
   fprint TEXT$, TextBox(TextBoxFocus).X + 4, TextBox(TextBoxFocus).Y, 0, 1
  END IF
 ELSE
  IF LEN(TEXT$) >= TextBox(TextBoxFocus).maxtext THEN
   PlayWarning
  ELSE
   TEXT$ = TEXT$ + result$
   TextBoxResult$(TextBoxFocus) = TEXT$
   fprint TEXT$, TextBox(TextBoxFocus).X + 4, TextBox(TextBoxFocus).Y, 0, 1
  END IF
 END IF

 TextBoxResult$(TextBoxFocus) = TEXT$
END IF

END SUB

SUB pxwindow (LH, UV, mr, mb, mc, CT, DT, DTA$, ta)
   
    IF hidew = 0 THEN
    
    IF UPDATEW >= 2 THEN
    
     IF LH <> (LH1) OR UV <> (UV1) THEN
     LINE (LH, UV)-(mr, mb), mc, BF
     LINE (LH, UV)-(mr, mb), 1, B
    
     LINE (LH + 2, UV + 2)-(mr - 2, mb - 2), 0, B
    
     LINE (LH, UV)-(LH + 10, UV + 10), 0, B
     LINE (mr - 10, UV + 10)-(mr, UV), 1, BF
    
      LINE (LH + 12, UV + 4)-(mr - 12, UV + 8), 3, BF
      LINE (LH + 12, UV + 4)-(mr - 12, UV + 8), 0, B
    
         LH1 = LH
         UV1 = UV

      'DRAWTEXTBOX 1
      IF DT = 1 THEN
     END IF
 X = LH
Y = UV
XLEN = 20
YLEN = 30
     
      IF DTA$ <> "" AND DT = 7 THEN
      TEXT$ = DTA$
      MTextBox 0, X + 10, Y + 20, 100, TEXT$
      END IF
    
      END IF


      
     END IF

'ListBox(1).NumItems = 20
'ListBox(1).selected = ListBoxFocus
     
 END IF
 



     
     SELECT CASE (DT)
     CASE IS = 0
      ' pxwct = ct
      'txt$ = tmarry$(pxwct, 0)
          H = LH + 12
          V = UV + 12: s = 1
          c = 1
    
     CALL prtext(txt$, H, V, s, c, mr, mb)
     
   
    CASE IS = 1

      B = 0
      swth = mr
      shht = mb
     
          'ag = 20
          'Ta = 20
          
      'CALL VBDRAW(lh, uv, ag, qa, ta, dta$, H, v, B, swth, shht)
        
         
           'ag = ag + 1: IF ag > 360 THEN ag = 1
            ta = ta + 1: IF ta > 360 THEN ta = 1
           'qa = qa + 1: IF qa > 360 THEN qa = 1
         

    CASE IS = 2
       H = LH + 20
       V = UV + 20
      txt$ = lcmd$
      s = 1
      c = 7
      CALL prtext(txt$, H, V, s, c, mr, mb)

    CASE IS = 3


      X = INT(RND(1) * (100)) + 1
      Y = INT(RND(1) * (100)) + 1
      X = X + LH + 20
      Y = Y + UV + 20
      c = INT(RND(1) * (16)) + 1
      CIRCLE (X, Y), 10, c




    END SELECT

    IF mc = 0 THEN
    LINE (LH, UV)-(mr, mb), mc, BF
    END IF


'END IF
END SUB

SUB Qbprun (filena$)


CALL cleartxt

LOCATE 2, 10: PRINT "                        "
LOCATE 3, 10: PRINT "#####################"
LOCATE 4, 10: PRINT "# Run " + filena$
LOCATE 5, 10: PRINT "#####################"
LOCATE 6, 10: PRINT "                       "
 SLEEP
 DO
 INPUT ke$
  IF ke$ = "Y" THEN
  
   sv$ = RIGHT$(filena$, 4)

   SELECT CASE (sv$)
   CASE IS = ".BAS"

    CHAIN filena$
      REM LH /L:1;2;3;4 +
  
   CASE IS = ".EXE"
   
    SHELL "LH" + filena$
  
   CASE IS = ".BAT"
    SHELL filena$

   CASE IS = ".COM"
    SHELL filena$
  
   CASE IS = ".BAT"
    SHELL filena$
  
   CASE IS = ".WAV"
  
   'CALL initsound
   'CALL playwav(filena$)
  
   END SELECT
 
  END IF

  
 LOOP UNTIL ke$ = "Y" OR ke$ = "N"
 
      wlength = 5
   CALL Pause(wlength)


  CALL cleartxt
 
  CALL pastebgtext

END SUB

SUB redraw


FOR xx = 1 TO ActiveListBoxes
 X = ListBox(xx).X
 Y = ListBox(xx).Y
 x2 = X + ListBox(xx).XLEN + 13
 y2 = Y + ListBox(xx).YLEN
 draww = ListBox(xx).redraw
 prev = ListBox(xx).selected

 IF draww = 1 THEN
  IF (MousexPos >= x2) OR (MousexPos <= X) OR (MouseyPos >= y2) OR (MouseyPos <= Y) THEN
   ListBox(xx).redraw = 0
   DrawListBox xx
   SetListBoxFocus xx, prev
  END IF
 END IF
NEXT xx
END SUB

SUB ROTATE (DTA$, an, qa, ta, swth, shht, sh, sv)
ta = ta
ta1 = ta
  H = sh
  V = sv

  H1 = H
  V1 = V
h2 = h2
v2 = V1

rt = 1
DO
'dta$ = "TA" + Str$(STA) + ";" + "QA" + Str$(QA) + ";" + Text1
rt = rt + 1
B = 1
'CALL VBDRAW(lh, uv, ag, qa, ta1, dta$, H1, V1, B, swth, shht)
  H = sh
  V = sv
  H1 = H: V1 = V
ta1 = ta


ta = ta + 5

IF ta > 360 THEN ta = 1


B = 0
'CALL VBDRAW(lh, uv, ag, qa, ta, dta$, H, v, B, swth, shht)
ke$ = INKEY$
ke$ = UCASE$(ke$)

LOOP UNTIL rt = (360 / 5) OR ke$ = "Q"
  B = 1
  'CALL VBDRAW(lh, uv, ag, qa, ta1, dta$, H1, V1, B, swth, shht)

END SUB

SUB scdelay (dl)

REM this sub runs the delay for the
REM screen saver

CT = 0

DO

CT = CT + 1

LOOP UNTIL CT >= (dl)


END SUB

SUB scrnsaver
 REM the screen Saver !! :)
'SCREEN 2
CLS ' clear the screen


 sp = 5
 DO



  ke$ = INKEY$' read keyboard
   ke$ = UCASE$(ke$)' set input to upper case
       
        c = c + 1
        IF c > 15 THEN c = 0

        CIRCLE (hl, vl), 30, c
        CIRCLE (hl1, vl1), 30, 0
      
        hl1 = hl
        vl1 = vl

      
         IF rt = 0 THEN
          hl = hl + sp
           IF hl > (600 - 100) THEN rt = 1
           END IF
         IF rt = 1 THEN
           hl = hl - sp
           IF hl <= 0 THEN rt = 0: hl = 0
           END IF

         IF dn = 0 THEN
           vl = vl + sp
           IF vl > (400) THEN dn = 1
           END IF
         IF dn = 1 THEN
           vl = vl - sp
           IF vl <= 0 THEN dn = 0: vl = 0

           END IF

  dl = 4100
  CALL scdelay(dl)


  CALL mouse(DX, CX, BX)
  IF BX > 0 THEN ex = 1


 LOOP UNTIL ke$ = CHR$(27) OR ex = 1




END SUB

SUB SetListBoxFocus (posi, prev)

row = ListBox(posi).Y + 3
X = ListBox(posi).X
XLEN = X + ListBox(posi).XLEN
Y = ListBox(posi).Y
top = ListBox(posi).top
selected = ListBox(posi).selected
old$ = ListBoxContent$(posi, prev + top - 1)
new$ = ListBoxContent$(posi, selected + top - 1)
NumItems = ListBox(posi).NumItems
SelectedLine(posi) = (selected + top - 1)


IF prev = 1 THEN
 LINE (X + 2, row + 2)-(XLEN - 2, row + 9), 15, BF
 fprint old$, X + 5, row, 0, 2
ELSE
 FOR ss = 1 TO NumItems
  IF ss = prev THEN
   LINE (X + 2, row + 2)-(XLEN - 2, row + 9), 15, BF
   fprint old$, X + 5, row, 0, 2
  ELSE
   row = row + 10
  END IF
 NEXT ss
END IF


row = ListBox(posi).Y + 3
IF selected = 1 THEN
 LINE (X + 2, row + 2)-(XLEN - 2, row + 9), 1, BF
 fprint old$, X + 5, row, 15, 2
ELSE
 FOR ss = 1 TO NumItems
  IF ss = selected THEN
   LINE (X + 2, row + 2)-(XLEN - 2, row + 9), 1, BF
   fprint old$, X + 5, row, 15, 2
  ELSE
   row = row + 10
  END IF
 NEXT ss
END IF





END SUB

SUB SetNewFocus



 IF mouseleftbutton = -1 THEN
  FOR xx = 1 TO ActiveTextBoxes
   IF (MousexPos >= TextBox(xx).X) AND (MousexPos <= TextBox(xx).X + TextBox(xx).lenght) AND (MouseyPos >= TextBox(xx).Y) AND (MouseyPos <= TextBox(xx).Y + 17) THEN
    PrintLabel TextBoxFocus, 0
    TextBoxFocus = xx
    PrintLabel TextBoxFocus, 15
   END IF
  NEXT xx
 ELSE
  IF TextBoxFocus = ActiveTextBoxes THEN
   PrintLabel TextBoxFocus, 0
   TextBoxFocus = 1
   PrintLabel TextBoxFocus, 15
  ELSE
   PrintLabel TextBoxFocus, 0
   TextBoxFocus = TextBoxFocus + 1
   PrintLabel TextBoxFocus, 15
  END IF
 END IF


 IF mouseleftbutton = -1 THEN
  FOR xx = 1 TO ActiveButtons
   IF (MousexPos >= Button(xx).X) AND (MousexPos <= Button(xx).X + Button(xx).lenght) AND (MouseyPos >= Button(xx).Y) AND (MouseyPos <= Button(xx).Y + 17) THEN
    DrawButtonDown xx
    ButtonFocus = xx
    DO WHILE mouseleftbutton = -1 AND (MousexPos >= Button(xx).X) AND (MousexPos <= Button(xx).X + Button(xx).lenght) AND (MouseyPos >= Button(xx).Y) AND (MouseyPos <= Button(xx).Y + 17)
     XMOUSE 3
    LOOP
    DrawButton xx
   END IF
  NEXT xx
 END IF

END SUB

SUB sgline (ag, VR, EA, ANGLE, sz, X, Y, H, V, c, size, BL, n, swth, shht)

IF VR = 0 THEN VR = 1
  cl = 0
  ai = 5
 
  ai = ai * 3.142857 / 180
   EA = EA * 3.142857 / 180
   'FOR TR = (ANGLE) TO (ANGLE + EA) STEP AI
  
   'NEXT TR
'agc = AG * 3.142857 / 180
 
'FOR ATR = (AI) TO (AI + agc) STEP AI
'NEXT ATR
 
DO
  'AGD = AG * 3.142857 / 180
  cl = cl + sz
  X = H + (cl * size) * COS(TR)
  Y = V + (cl * size) * SIN(TR) / VR '* ATR
  IF BL = 0 THEN
  'IF x > 0 AND x < swth AND y > 0 AND y < shht THEN
    LINE (H, V)-(X, Y), c
  'END IF
  END IF


LOOP UNTIL (cl) >= (sz * scale)

BL = 0
IF n = 1 THEN
X = H
Y = V
n = 0
END IF

END SUB

SUB TBox (LH, UV, mr, mb, mc)


MLimit = 100
CT = 0

CALL mouse(CX, DX, BX): BU = BX
DO

LH = marry(CT, 0): mr = marry(CT, 2)
UV = marry(CT, 1): mb = marry(CT, 4)

  IF BU = 1 AND MOUSEH > (mr - 10) AND MOUSEV < (UV + 10) AND MOUSEH < (mr) AND MOUSEV > (UV) THEN
   mc = 0
   LINE (LH, UV)-(mr, mb), mc, BF
 
   marry(CT, 0) = 0
   marry(CT, 1) = 0
   marry(CT, 2) = 0
   marry(CT, 3) = 0
 
   mr = 0
   mb = 0
 
   END IF


IF mr = 0 AND mb = 0 THEN

CT = CT + 1
ELSE

    IF MOUSEH > (LH) AND MOUSEH < (mr) AND MOUSEV > (UV) AND MOUSEV < (mb) THEN
    
    
    CALL pxwindow(LH, UV, mr, mb, mc, CT, DT, DTA$, ta)


    END IF
   END IF

  IF mc = 0 THEN
  LINE (LH, UV)-(mr, mb), 0, B
END IF

CT = CT + 1


LOOP UNTIL CT >= (MLimit)

END SUB

SUB TextPl (THP, TVP, TE$)


IF THP <= (thplim) AND TVP <= (tvplim) THEN

LOCATE TVP, THP
PRINT TE$;


ELSE

LOCATE 1, 1
PRINT " ERROR"
PRINT "  invalid screen location  "
PRINT "< "; THP; " -  "; TVP; " >"

END IF





END SUB

SUB tmouse (mh, mv)


mh = (MOUSEH / 8) + 1
mv = (MOUSEV / 8) + 1

IF mh > thplim THEN mh = thplim
IF mv > tvplim THEN mv = tvplim


'IF mh1 <> (mh) OR mv1 <> (mv) THEN
'  sec = 0
'END IF


'bgcw$ = CHR$(SCREEN(mv, mh))



END SUB

SUB typef

 filena$ = UCASE$(filena$)
   sv$ = RIGHT$(filena$, 4)


IF sv$ = ".BAT" OR sv$ = ".BAS" OR sv$ = ".EXE" OR sv$ = ".COM" OR sv$ = ".WAV" THEN


CALL Qbprun(filena$)


END IF


SHELL "type " + filena$


END SUB

SUB udocs (ocs$, ocsm)



ocsm = ocsm + 1
IF ocsm > 3 THEN ocsm = 0

   ocs$ = ""


SELECT CASE (ocsm)

  CASE IS = 0
    ocs$ = CHR$(220)
  CASE IS = 1
    ocs$ = CHR$(222)
  CASE IS = 2
    ocs$ = CHR$(223)
  CASE IS = 3
    ocs$ = CHR$(221)




END SELECT


END SUB

SUB umouse (ya, xa, BU, si)
 ' 10, 10
 'PRINT ril, bot

 '
   CALL mouse(MCX, MDX, BX)
      MOUSEH = DX: MOUSEV = CX

'
SELECT CASE (mpticon)
CASE IS = 0
   REM (((( Target point ))))
   IF MOUSEH > Ril THEN MOUSEH = Ril
   IF MOUSEH < 1 THEN MOUSEH = 1
   IF MOUSEV > Bot THEN MOUSEV = Bot
   IF MOUSEV < 1 THEN MOUSEV = 1

mh = (MOUSEH / 8) + 1
mv = (MOUSEV / 16) + 1


IF mouseh1 <> (MOUSEH) OR mousev1 <> (MOUSEV) THEN
     'sec = 0

IF MOUSEH < (Ril - (si + 1)) AND MOUSEV < (Bot - (si + 1)) THEN
   PUT (mouseh1, mousev1), box%, PSET
   GET (MOUSEH, MOUSEV)-(MOUSEH + si, MOUSEV + si), box%
   
    mouseh1 = MOUSEH
    mousev1 = MOUSEV


CALL drawPointer
END IF

END IF
CASE IS = 1
END SELECT

    
 


END SUB

SUB UpdateListBox (posi, top, way)

X = ListBox(posi).X
Y = ListBox(posi).Y
XLEN = ListBox(posi).XLEN
YLEN = ListBox(posi).YLEN
TEXT$ = ListBoxLabel$(posi)
NumItems = ListBox(posi).NumItems
show = ListBox(posi).show
top = ListBox(posi).top
prev = ListBox(posi).selected

IF way = 0 THEN
 IF ((top + show) - 1) = NumItems THEN
  PlayWarning
 ELSE
  top = top + 1
  LINE (X + 2, Y + 2)-(X + XLEN - 2, Y + YLEN - 2), 15, BF
  row = Y
  row = row + 3
  ctr = 0
  FOR ff = 1 TO show
   fprint ListBoxContent$(posi, top + ctr), X + 5, row, 0, 2
   ctr = ctr + 1
   row = row + 10
  NEXT ff
 END IF
 ListBox(posi).top = top
 SetListBoxFocus posi, prev
 EXIT SUB
END IF

IF way = 1 THEN
 IF top = 1 THEN
  PlayWarning
 ELSE
  top = top - 1
  LINE (X + 2, Y + 2)-(X + XLEN - 2, Y + YLEN - 2), 15, BF
  row = Y
  row = row + 3
  ctr = 0
  FOR ff = 1 TO show
   fprint ListBoxContent$(posi, top + ctr), X + 5, row, 0, 2
   ctr = ctr + 1
   row = row + 10
  NEXT ff
 END IF
 ListBox(posi).top = top
 SetListBoxFocus posi, prev
END IF

END SUB

SUB VBCH (dat$, H, V, sz, c)
X = H
Y = V
X1 = H
Y1 = Y
REM BUILD DATA
ll = LEN(dat$)
FOR CT = 1 TO (ll)
ch$ = MID$(dat$, CT, 1)
 ch$ = UCASE$(ch$)
 
 REM ACTUALLY DRAWLING SHAPE

IF ch$ = "L" THEN X = X - sz
IF ch$ = "D" THEN Y = Y + sz
IF ch$ = "R" THEN X = X + sz
IF ch$ = "U" THEN Y = Y - sz
IF ch$ = "F" THEN X = X - sz: Y = Y + sz
IF ch$ = "G" THEN X = X + sz: Y = Y + sz
IF ch$ = "H" THEN X = X - sz: Y = Y - sz
IF ch$ = "E" THEN X = X + sz: Y = Y - sz



LINE (X1, Y1)-(X, Y), c
X1 = X: Y1 = Y
NEXT CT
END SUB

SUB wamouse

LOCATE 23, 15: PRINT "W";
DO
CALL mouse(MCX, MDX, BX)


LOOP UNTIL BX = 0


LOCATE 23, 15: PRINT " ";

END SUB

SUB winloop



TextBoxFocus = 1
ButtonFocus = 0
ListBoxFocus = 1

'=========== CREATE YOUR 3D OBJECTS HERE ============

'mButton 1, 10, 50, 80, "3d Button"
MTextBox 1, 150, 50, 100, "Text Box"
'mTextBox 2, 300, 50, 100, "Text Box 2"
'mTextBox 3, 450, 50, 100, "Text Box 3"

' Fill List Box 1
ListBox(1).NumItems = 20
ListBox(1).selected = ListBoxFocus
FOR ss = 1 TO 20
 READ one$
 ListBoxContent$(1, ss) = one$
NEXT ss
mListBox 1, 100, 200, 100, 100, "List Box"

SetListBoxFocus 1, ListBoxFocus


' Start Main Loop
'================

 DO
  result$ = INKEY$
 ' redraw
 LOOP UNTIL result$ <> "" OR mouseleftbutton = -1

 IF mouseleftbutton = -1 THEN
  SetNewFocus
  CheckListBox
 
  '================= Check 3D Objects =================

  IF ButtonFocus = 1 THEN
   IF SelectedLine(1) = 5 THEN
    BEEP
   END IF
  END IF





 END IF
 SELECT CASE result$
  CASE CHR$(9): SetNewFocus
  CASE "q": SYSTEM
  CASE ELSE: PutCharOnBox (result$)    'Puts A Character into a Text box
 END SELECT
 ButtonFocus = 0   'resets value




CLOSE #1
CLOSE #2


END SUB

DEFSNG A-Z
SUB WORLDSCALE (DTA$, SE$)
CLS
ll = LEN(DTA$)

DO
CT = CT + 1
ch$ = MID$(DTA$, CT, 1)
  ch$ = UCASE$(ch$)
LOOP UNTIL ch$ = "S" OR CT >= (ll)

DO
CT = CT + 1
ch$ = MID$(DTA$, CT, 1)

NN$ = NN$ + ch$

LOOP UNTIL ch$ = ";" OR CT >= (ll)

num$ = MID$(NN$, 1, LEN(NN$) - 1)


PRINT " CURRENT SCALE <"; num$
INPUT "NEW SETTING <"; SE$
IF SE$ <> "" THEN
LDTA$ = RIGHT$(DTA$, ll - CT)
PRINT LDTA$

DTA$ = "S" + SE$ + ";" + LDTA$
ELSE
PRINT " NO CHANGE MADE"
SLEEP
END IF

END SUB

DEFINT A-Z
SUB XMOUSE (which)
'0 = Mouse Init
'1 = Mouse Driver
'2 = Mouse Put
'3 = Mouse Status
'4 = Mouse Hide
'5 = Mouse Show
IF which = 0 THEN
  mouser$ = SPACE$(57)
  FOR I% = 1 TO 57
    READ a$
    H$ = CHR$(VAL("&H" + a$))
    MID$(mouser$, I%, 1) = H$
  NEXT I%
  AX% = 0
  BX% = 0
  CX% = 0
  DX% = 0
  XMOUSE 1
  MouseInit% = AX%
  XMOUSE 5
END IF
IF which = 1 THEN
  DEF SEG = VARSEG(mouser$)
  mouser% = SADD(mouser$)
  CALL absolute(AX%, BX%, CX%, DX%, mouser%)
END IF
IF which = 2 THEN
  AX% = 4
  CX% = X%
  DX% = Y%
  BX% = 0
  XMOUSE 1
END IF
IF which = 3 THEN
  AX% = 3
  XMOUSE 1
  mouseleftbutton = ((BX% AND 1) <> 0)
  mouserightbutton = ((BX% AND 2) <> 0)
  MousexPos = CX%
  MouseyPos = DX%
END IF
IF which = 4 THEN
 AX% = 2
 BX% = 0
 CX% = 0
 DX% = 0
 XMOUSE 1
END IF
IF which = 5 THEN
  AX% = 1
  BX% = 0
  CX% = 0
  DX% = 0
  XMOUSE 1
END IF

'LOCATE 4, 4
' PRINT AX, CX, DX, BX,

 MCX = DX
 MDX = CX

END SUB

