DECLARE SUB MENU ()
DECLARE SUB SHOW ()
DECLARE SUB PART (H%, V%, P%)
DECLARE SUB INCERTPEICE ()
DECLARE SUB CARROW (H%, V%, BU%)
DEFINT A-Z
DECLARE SUB MOUSE (cx%, dx%, BX%)
DECLARE SUB MousePointer (SW%)
DECLARE SUB PAUSE (wlength!)
DECLARE SUB handleerror ()
DECLARE SUB link ()
DECLARE SUB dokeyboard (KE$, txt$)
DECLARE SUB udocs (ocs$, ocsm%)
DECLARE SUB LOGO ()
DECLARE SUB windowbox (H%, V%, x%, y%, c%, c2%, txt$, rtxt$, KE$, DTXT$)
DECLARE SUB box (H%, V%, x%, y%, c%)
DECLARE SUB VerLine (H%, V%, bt%, c%)
DECLARE SUB horline (H%, V%, x%, c%)
COMMON SHARED CR$, ocs$, comm$, LTIME$
COMMON SHARED ocsm, modem, cur1, H1, V1, SCLH, SCLV, WRH, WRV, PCT
DIM SHARED PEICE(200, 4)
DIM SHARED PEICET$(200)

    
        REM %%%%% SPECIAL THANKS TO  Jeff Barnette  %%%%%
        REM %%%%% FOR THIS MOUSE ROUTINE %%%%%
     
     
     
         DIM SHARED a(9): REM %%% FOR MOUSEROUTINE %%%

        DEF SEG = VARSEG(a(0))
   
        RESTORE
        FOR I = 0 TO 17
        READ r
        POKE VARPTR(a(0)) + I, r
        NEXT I
        DATA &HB8,&H00,&H00,&H55,&H8B,&HEC,&HCD,&H33,&H92
        DATA &H8B,&H5E,&H06,&H89,&H07,&H5D,&HCA,&H02,&H00
        CALL MousePointer(0)      'Reset mouse and
        CALL MousePointer(3)      'Get coordinates

SCLH = 1
SCLV = 1
WRH = 0
WRV = 0
SCREEN 12


  CR$ = CHR$(13)

       
        'comm$ = "Com1:19200,8,n,1,CD0,CS0,DS0,OP0,RS,TB2048,RB2048"
        'OPEN "COM1:19200,N,8,1,CD0,CS0,DS0,OP0,RS,TB2048,RB2048" FOR RANDOM AS #1
        
        'COM(1) ON
        'modem = 1

DO

  

KE$ = INKEY$

CALL MENU


CALL SHOW


CALL CARROW(H, V, BU)
IF BU = 1 THEN CALL INCERTPEICE


SCLH = (H + 1) / 16
SCLV = (V + 1) / 16


IF KE$ = CHR$(0) + "M" THEN WRH = WRH + 1
IF KE$ = CHR$(0) + "K" THEN WRH = WRH - 1: IF WRH < 0 THEN WRH = 0
IF KE$ = CHR$(0) + "P" THEN WRV = WRV + 1
IF KE$ = CHR$(0) + "H" THEN WRV = WRV - 1: IF WRV < 0 THEN WRV = 0



IF WRH <> (LWRH) OR WRV <> (LWRV) THEN CLS : LWRH = WRH: LWRV = WRV

LOOP UNTIL KE$ = CHR$(27)





PRINT "@@@@@@@@@@@@@@@"
PRINT " EXIT PROGRAM"

END

SUB box (H, V, x, y, c)



     rl = x
     bt = y

    CALL horline(H, V, rl, c)
   
    CALL horline(H, y, rl, c)

    CALL VerLine(H, V, bt, c)
   
   
    CALL VerLine(x, V, bt, c)


END SUB

SUB CARROW (H, V, BU)

    CALL MOUSE(YA, XA, BU)
    H = XA: V = YA

    CIRCLE (H, V), 20, 7
    PSET (H, V), 4

    IF H1 <> (H) OR V1 <> (V) THEN

    CIRCLE (H1, V1), 20, 0
    PSET (H1, V1), 0

    H1 = H
    V1 = V
  
   END IF

END SUB

DEFSNG A-Z
SUB dokeyboard (KE$, txt$)
 

 KE$ = INKEY$


 IF KE$ <> "" THEN

 IF KE$ = CHR$(0) + "H" THEN
   KE$ = CHR$(30)
 END IF
 IF KE$ = CHR$(0) + "P" THEN
   KE$ = CHR$(31)
 END IF
 IF KE$ = CHR$(0) + "M" THEN
   KE$ = CHR$(16)
 END IF
 IF KE$ = CHR$(0) + "K" THEN
   KE$ = CHR$(17)
 END IF



 'PRINT #1, ke$

 END IF

 'ON COM(1) GOSUB inout:



 'ON COM(1) GOSUB send:

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

   ll = LEN(txt$)
   pc = (ll - 2)
  
   IF pc >= 1 THEN
   frg$ = LEFT$(txt$, pc)
   txt$ = frg$
   KE$ = ""
   END IF




 END SELECT

 IF KE$ <> "" THEN
 txt$ = txt$ + KE$

 END IF

END SUB

SUB handleerror
CLS
SCREEN 0, 0, 0

 COLOR 1, 2, 1

 SELECT CASE (ERR)
 CASE IS = 0
 messer$ = ":) SYSTEM CALL  <R> to return "

 CASE IS = 1
 CASE IS = 2
  messer$ = "Syntaz error"
 CASE IS = 3
  messer$ = "Return without Gosub"
 CASE IS = 5
  messer$ = " illeagle function call "


 CASE IS = 20
  messer$ = "Resume without Error"
 CASE IS = 24
  messer$ = "Device Time out "

 CASE IS = 27
  messer$ = "Out of paper"

 CASE IS = 52
  messer$ = "bad file name or unknown."
 CASE IS = 55
  messer$ = " file already opened "

 CASE IS = 75
  messer$ = "Path File access Error"

 END SELECT


  DTXT$ = " @@@@@ error @@@@@ " + STR$(ERR) + CR$
  'CALL SENDDATA(DTXT$)

  wlength = 2
 CALL PAUSE(wlength)
LOCATE 1, 3


LOCATE 3, 20: PRINT "  "; STRING$(32, "#")
LOCATE 4, 20: PRINT "  #### Opperating System ERROR ### "
LOCATE 5, 20: PRINT "  "; STRING$(32, "#")
LOCATE 6, 22: PRINT "< "; messer$; " >"

LOCATE 15, 5

PRINT "  Number -  < "; ERR; " >"
      PRINT
      PRINT " COMM PORT % " + cmm$
    SOUND 100 + ERR, 3
PRINT "READY hit <esc> to reboot..."
PRINT " your data will not be harmed."



oswait = 0
DO

 CALL dokeyboard(KE$, txt$)

 PRINT " Hex ( "; HEX$(ERR)
 PRINT " Oct ( "; OCT$(ERR)


 LOCATE 1, 21: PRINT TIME$

 PRINT "key = "; KE$

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

 PRINT lc, rc
 PRINT " Hex ("; HEX$(lc); ") Hex ("; HEX$(rc); ")   "
 PRINT " Oct ("; OCT$(lc); ") Oct ("; OCT$(rc); ")   "

 LOCATE 20, 1: PRINT " Restart OS in TMinus <"; 12 - oswait
 LOCATE 21, 2: PRINT "< "; messer$; " >"

  IF KE$ = "R" THEN
   DTXT$ = ""
   EXIT SUB
  END IF


  IF KE$ = "A" THEN
     CLS
     LOCATE 5, 1
     PRINT "Reloading Plexer Please wait"
     
       DTXT$ = " RELOADING... " + CR$
   
     'CALL SENDDATA(DTXT$)

     wlength = 5
     CALL PAUSE(wlength)

     na$ = "A:plexeros.bas"
     'OScall (na$)
  END IF
  IF KE$ = "M" THEN
 
   'ON ERROR GOTO cer:
  modem = 0: EXIT SUB
  END IF


  IF KE$ = "C" THEN
  OPEN "com1:19200,n,8" FOR RANDOM AS #1

  END IF

IF ERR <> 0 THEN
 IF time1$ <> (TIME$) THEN

  time1$ = TIME$
  oswait = oswait + 1
  IF oswait >= 12 THEN
  KE$ = CHR$(27) ' RUN
  PRINT
  PRINT "Forcing Reboot ..."
  PRINT
     REM restart OS
    RUN
    END IF
 END IF
END IF




LOOP UNTIL KE$ = CHR$(27)


END SUB

DEFINT A-Z
SUB horline (H, V, x, c)





LOCATE V, H
COLOR c
rl = H
DO

LOCATE V, rl
PRINT CHR$(219)
rl = rl + 1
LOOP UNTIL rl = x OR rl >= 80

END SUB

SUB INCERTPEICE

LOCATE 27, 1: PRINT SCLH, SCLV
'INPUT "NAME "; NM$



 PEICE(PCT, 0) = 1
 PEICE(PCT, 1) = SCLH + WRH
 PEICE(PCT, 2) = SCLV + WRV
 PCT = PCT + 1


SOUND 125, 3

DO
CALL MOUSE(cx, dx, BX)

LOOP UNTIL BX = 0

END SUB

SUB link

 H = 1
 V = 1
 x = 79
 y = 20
 c = 4
 c2 = 7

 DO
 DTXT$ = "Term :> " + comm$ + "  " + TIME$
 rtxt$ = "~"
 CALL windowbox(H, V, x, y, c, c2, txt$, rtxt$, KE$, DTXT$)

 CALL dokeyboard(KE$, txt$)

 IF KE$ <> "" THEN


 'ON COM(1) GOSUB send:

 PRINT #1, KE$

 END IF




 LOOP UNTIL KE$ = CHR$(27)

END SUB

SUB LOGO
CR$ = CHR$(13)

H = 1
V = 2
x = 65
y = 23

c = 7
txt$ = ""
       txt$ = "M   M  OOO  DDD    888   000   GGG  RRRR  " + CR$
txt$ = txt$ + "MM MM O   O D  D  8   8 0  00 G     R   R" + CR$
txt$ = txt$ + "M m m O   O D  D  88888 0 0 0 G GGG RRRR  " + CR$
txt$ = txt$ + "M M M O   O D  D  8   8 00  0 G   G R   R" + CR$
txt$ = txt$ + "M M M  OOO  DDD    888   000   GGG  R   R " + CR$
 rtxt$ = CHR$(32)
 CALL windowbox(H, V, x, y, c, c2, txt$, rtxt$, KE$, DTXT$)



END SUB

SUB MENU

LOCATE 27, 15: PRINT SCLH, SCLV, PCT

LOCATE 1, 65: PRINT WRH
LOCATE 2, 65: PRINT WRV
LINE (0, 0)-(500, 400), 7, B

END SUB

SUB MOUSE (cx, dx, BX)
       
       
      

           POKE VARPTR(a(4)), &H92           'Swap code,Get CX setup
          CALL absolute(cx, VARPTR(a(0)))     'Run Code
              cx = cx                     'Adjust 25x80
           POKE VARPTR(a(4)), &H91           'Swap code,Get DX setup
          CALL absolute(dx, VARPTR(a(0)))     'Run Code
              dx = dx                     'Adjust 25x80
           POKE VARPTR(a(4)), &H93           'Swap code,Get BX setup
          CALL absolute(BX, VARPTR(a(0)))     'Run Code



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 PART (H, V, P)




DH = (H * 16) - (WRH * 16)
DV = (V * 16) - (WRV * 16)



SELECT CASE (P)

CASE IS = 1
D$ = "R50D50L50U50"

END SELECT

IF DH <= 500 AND DH > 0 AND DV <= 400 AND DV > 0 THEN

DRAW "BM0,0BR" + STR$(DH) + "BD" + STR$(DV) + D$

END IF
END SUB

DEFSNG A-Z
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$

IF KE$ = CHR$(27) THEN mpb = wlength

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


END SUB

DEFINT A-Z
SUB SHOW

FOR CT = 0 TO 200

P = PEICE(CT, 0)
H = PEICE(CT, 1)
V = PEICE(CT, 2)


CALL PART(H, V, P)



NEXT CT

END SUB

SUB udocs (ocs$, ocsm)



IF TIME$ <> (LTIME$) THEN
ocsm = ocsm + 1

LTIME$ = TIME$
END IF
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



 IF cur1 = 0 THEN

 ocs$ = "_" + ocs$ + " "
  cur1 = 1
 ELSE

 ocs$ = " " + ocs$ + " "
 cur1 = 0
 END IF

END SUB

SUB VerLine (H, V, bt, c)

 tv = V

 DO

 LOCATE tv, H

 PRINT CHR$(219);

 tv = tv + 1

 LOOP UNTIL tv > (bt) OR tv >= 24




END SUB

SUB windowbox (H, V, x, y, c, c2, txt$, rtxt$, KE$, DTXT$)

CALL box(H, V, x, y, c)


LOCATE V + 1, H + 1: PRINT DTXT$
JV = V + 2
JH = H + 3

ll = LEN(txt$)
CT = 1
DO
 IF CT > (ll) THEN
  CT = ll
  ch$ = " "
 ELSE
 ch$ = MID$(txt$, CT, 1)
  th = JH
  tv = JV

 END IF
COLOR c2
LOCATE JV, JH: PRINT ch$; KE$

JH = JH + 1

 IF JH > (x - 1) THEN
  JH = H + 1
  JV = JV + 1
  CT = ll
  END IF


   IF ch$ = CHR$(13) THEN JV = JV + 1: JH = H + 1

   IF JV > (y - 1) THEN
      JV = V + 1
   END IF


 CT = CT + 1


LOOP UNTIL CT >= (ll)' AND JV >= y - 1
 IF tv < 1 THEN tv = 1
 IF th < 1 THEN th = 1




 DO
 CALL dokeyboard(KE$, txt$)

 SCREEN 0, 0, 0
 COLOR 7, 0
 CALL udocs(ocs$, ocsm)
 LOCATE tv, th + 1: PRINT ocs$;
 

 LOCATE 23, 50: PRINT TIME$
 IF KE$ <> "" THEN
  lc = ASC(LEFT$(KE$, 1)): rc = ASC(RIGHT$(KE$, 1))
 END IF




 LOCATE y - 1, x - 10: PRINT lc; " "; rc
 LOOP UNTIL KE$ = rtxt$ OR rtxt$ = "~"



END SUB

