DECLARE SUB HEKEY (HX!, HV!, RCH$)
DECLARE SUB HEBLOC (HH!, VV!, CH$)
DECLARE SUB scroll ()
DECLARE SUB WORDLEARN (PA$, OUTPA$)


'DEFINT A-Z
DECLARE SUB MOUSE (which)
DECLARE SUB UDCUR ()
DECLARE SUB BOX (X!, Y!, C!)
DECLARE SUB PLACE (CUC!)
DECLARE SUB PRSCREEN ()
DECLARE SUB CHARACTER (X!, Y!, CH$, C!, SIZE!)

'=============== MOUSE STUFF ==============


DIM SHARED mouser$, MouseLeftButton, MouseRightButton, MOUSEXPOS, MOUSEYPOS, AX%, bx%, cx%, dx%
COMMON SHARED X, Y, C, BC, X1, Y1, CURTPX
COMMON SHARED MSPLACE
COMMON SHARED MESS$, ctx$


MOUSE 0


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

' ==========================================


REM THIS IS A QBASIC PROGRAM THAT ALLOWS YOU TO
REM WRITE
REM PRINT
REM EDIT
REM   HEBREW TEXT
REM THIS IS NOT A TRANSLATOR OR DICTIONARY
REM ALTHOUGH SOME SIMPLE EXPLAINATION IS PROVIDED
REM USERS ARE ASSUMED TO HAVE KNOWLEDGE OF THE JEWISH HEBREW LANGUAGE
REM this is really just a page editor for making books in hebrew
REM ENJOY
REM 2002 JUNE 15
REM PROGRAMED BY SCOTT W GATES
    DATA 205, 5, 203  : ' int 5  retf  'Machine-language code
                                       'for printing screen.

CLS
 MSPLACE = 1
 HNS = 0
 REM STANDS FOR HEBREW NUMBER SYSTEM
REM  ALEPH 1
SCREEN 12

 INPUT " do you have a mouse "; yn$
    yn$ = UCASE$(yn$)
  IF yn$ = "Y" OR yn$ = "YES" THEN
     MOUSE (1)
     PRINT MOUSEXPOS, MOUSEYPOS
  END IF
   CLS
   LOCATE 1, 1
   MESS$ = " LOOK CARE FULLY AT THE HEBREW TEXT ABCDEFGHIJKLMNOPQRSTUVWXYZ;,."
   
   DO
   LOCATE 4, 2: PRINT " <K> TO SEE HEBREY KEYSET"
   KE$ = INKEY$
    CALL scroll
     CALL HEKEY(30, 250, RCH$)
   LOOP UNTIL KE$ = CHR$(32)



   V = 1
   H = 43
C = 0: NT = 8 * 40 + 9
PAINT (1, 1), 7: BC = 7
X = 8 * 40
Y = 1



DO
CALL MOUSE(3)
CALL MOUSE(5)
CALL WORDLEARN(TEXT$, OUTPA$)
 LOCATE 20, 40: PRINT OUTPA$
EVX = 400: EVY = 300

                                                             

IF LC$ <> (NC$) THEN CALL CHARACTER(EVX, EVY, LC$, 7, 20): CALL CHARACTER(EVX, EVY, NC$, 0, 20): LC$ = NC$

IF J$ <> (TIME$) THEN CC = CC + 1: J$ = TIME$: IF CC > 1 THEN CC = 0
IF CC = 0 THEN CUC = BC
IF CC = 1 THEN CUC = 14

LINE (NT + 8, 0)-(NT + 8, 200), C
KE$ = INKEY$

CD = CD + 1: IF CD > 16 THEN CD = 0
DRAW "BM0,0BR" + STR$(EVX) + "BD" + STR$(EVY) + "C" + STR$(CD) + "S20BU2BL2R10D12L10U12"

IF KE$ = CHR$(0) + CHR$(143) THEN TEXT$ = "": KE$ = "": CH$ = ""
IF KE$ <> "" THEN CALL PLACE(BC): CUC = 7
IF KE$ = CHR$(0) + CHR$(64) THEN CALL PRSCREEN


'CALL PLACE(CUC)
CALL UDCUR

IF KE$ = CHR$(0) + CHR$(59) THEN CLS : LINE (0, 0)-(640, 200), (BC), BF: X = 8 * 40: Y = 1: H = 43: V = 1: KE$ = ""
IF KE$ = CHR$(13) THEN CALL PLACE(BC): X = 8 * 40: Y = Y + 10: H = 43: V = V + 1
IF KE$ = CHR$(0) + CHR$(80) THEN
   KE$ = ""
    CALL PLACE(BC)
    Y = Y + 10
  END IF
IF KE$ = CHR$(0) + CHR$(72) THEN CALL PLACE(BC): Y = Y - 10: IF Y < 1 THEN Y = 1
IF KE$ = CHR$(0) + CHR$(77) THEN KE$ = "": CALL PLACE(BC): : X = X + 9: IF X > (NT) THEN X = NT
IF KE$ = CHR$(0) + CHR$(75) THEN KE$ = "": CALL PLACE(BC): X = X - 9: IF X < 1 THEN X = NT


IF KE$ = CHR$(8) THEN
   CALL PLACE(BC)
   LINE (X, Y)-(X + 6, Y + 9), BC, BF
   X = X + 9
     IF X > (NT) THEN X = 1: Y = Y - 10: IF Y < 1 THEN Y = 1: BEEP
        
      KE$ = ""
      
 
  END IF

IF KE$ <> "" THEN

CALL PLACE(BC)
NC$ = KE$
CH$ = KE$
TEXT$ = TEXT$ + KE$

 X = X - 9: IF X < 1 THEN X = NT: Y = Y + 10
 CALL CHARACTER(X, Y, CH$, C, 4): REM SET SIZE TO 4 NORMAL

 H = H + 1: IF H > 79 THEN H = 43: V = V + 1
 IF V > 22 THEN V = 1
 LOCATE V, H: PRINT KE$
 
END IF

  IF Y > 200 - 8 THEN Y = 1







LOCATE 22, 1: PRINT "HEBREW": LOCATE 22, 70: PRINT "ENGLISH"
LOCATE 23, 1: PRINT "# "; HNS: LOCATE 23, 60: IF KE$ <> "" THEN PRINT "ASCII "; ASC(LEFT$(KE$, 1)); ASC(RIGHT$(KE$, 1))
LOOP UNTIL KE$ = CHR$(27)

SCREEN 0, 0, 0

SUB BOX (X, Y, C)

   LINE (X - 1, Y - 1)-(X + 8, Y + 10), C, B

END SUB

SUB CHARACTER (X, Y, CH$, C, SIZE)




 DRAW "BM 0,0S4BR" + STR$(X) + "BD" + STR$(Y) + "C" + STR$(C)
 DRAW "S" + STR$(SIZE)



SELECT CASE (CH$)
 CASE IS = ";'"
  DRAW "D3R2L2U3R6D8"
 CASE IS = ","
  DRAW "BD8R1U6D1R4D4F2"


 CASE IS = "."
  DRAW "R2D8U4E4"
  
 CASE IS = "A"
  DRAW "BD2D6R3U8L2R2D8R2U8"
 CASE IS = "B"
  DRAW "BR3R2D8L4"
 CASE IS = "C"
  DRAW "BR2R2D8R1L4"
 CASE IS = "D"
  DRAW "BR2R3D8U2L1D1L1D1"
 CASE IS = "E"
  DRAW "R6D4L2D1L1D3U6"
 CASE IS = "F"
  DRAW "R6D8L6"
 CASE IS = "G"
  DRAW "R2D8L2R2U1R2D1R2U8"
 CASE IS = "H"
  DRAW "BR3R2D2"
 CASE IS = "I"
  DRAW "BF1R2BD2D4"
 CASE IS = "J"
  DRAW "ND8R6D8"

 CASE IS = "K"
  DRAW "D1R6D6L4D1"

 CASE IS = "L"
  DRAW "R6D9"
  'LINE (x, y)-(x + 6, y), C
  'LINE -(x + 6, y + 9), C
 CASE IS = "M"
  DRAW "BD2F3E3G3F3L6"
 CASE IS = "N"
  DRAW "R6D7L4BD1BL2U6"

 CASE IS = "O"
  DRAW "R6D8L6U8"

  'LINE (x, y)-(x + 6, y + 8), C, B
 CASE IS = "P"
  DRAW "D3U3R6D8L6"

 CASE IS = "Q"
 CASE IS = "R"
 DRAW "BR2R4D4"

 CASE IS = "S"
  DRAW "R6L2D8"
 CASE IS = "T"
  DRAW "BD2D4BU6F6BU2U4"
 CASE IS = "U"
  DRAW "BR3R3L1D8"
 CASE IS = "V"
  DRAW "BD8U6BU2R6D8"

 CASE IS = "W"

 CASE IS = "X"

  DRAW "D5F3E3U5L6"
 CASE IS = "Y"
  DRAW "BD1D7R5U8G3"
 CASE IS = "Z"
  DRAW "BD2BR2R4L2D6"


END SELECT


 DRAW "S4"
END SUB

SUB HEBLOC (HH, VV, CH$)

'LOCATE VV, HH: PRINT CH$;
WDTH = 10
HEIGHT = 10
X = HH * WDTH
Y = VV * HEIGHT
SIZE = 4: C = 7
LINE (X, Y)-(X + WDTH, Y + HEIGHT), 0, BF
CALL CHARACTER(X, Y, CH$, C, SIZE)



END SUB

SUB HEKEY (HX, HV, RCH$)
  H = HX
  V = HV
  HSI = 250: VSI = 150
  LINE (H, V)-(H + HSI, V + VSI), 7, B
    

   X = H + 30
   Y = V + 1
   SIZE = 5
   C = 7

   CALL CHARACTER(X, Y, "E", C, SIZE)
   CALL CHARACTER(X + 10, Y, "R", C, SIZE)




   MX = MOUSEXPOS: MY = MOUSEYPOS


  IF MouseLeftButton = 1 AND MX >= (X) AND MX <= (X + HSI) AND MY >= (Y) AND MY <= (Y + VSI) THEN
   IF MY > (Y) AND MY < (Y + 10) THEN
    REM E-P
   END IF
   IF MY > (Y + 10) AND MY < (Y + 20) THEN
    REM A-K

   END IF
   IF MY > (Y + 30) AND MY < (Y + 40) THEN
    REM Z-M

   END IF

  END IF

END SUB

'DEFINT A-Z
SUB MOUSE (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
  MOUSE 1
  MouseInit% = AX%
  MOUSE 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
  MOUSE 1
END IF
IF which = 3 THEN
  AX% = 3
  MOUSE 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
 MOUSE 1
END IF
IF which = 5 THEN
  AX% = 1
  bx% = 0
  cx% = 0
  dx% = 0
  MOUSE 1
END IF



END SUB

SUB PLACE (CUC)
LINE (X - 8, Y - 1)-(X - 8 + 5, Y - 1), CUC, BF
END SUB

SUB PRSCREEN
REM
REM SEND SCREEN TO PRINTER
REM
    DIM A%(2)
    DEF SEG = VARSEG(A%(0))
    FOR i% = 0 TO 2
       READ d%
       POKE VARPTR(A%(0)) + i%, d%
    NEXT i%
    CALL Absolute(VARPTR(A%(0)))
    DEF SEG

END SUB

SUB scroll

REM text scrolling takes place here

L = LEN(MESS$)

IF ctx$ <> (TIME$) THEN
   ctx$ = TIME$: MSPLACE = MSPLACE + 1: IF MSPLACE >= (L) THEN MSPLACE = 1
END IF
T = 0
C$ = "": DT$ = ""
G = MSPLACE
VV = 20
HH = 1
DO
T = T + 1
G = G + 1
HH = HH + 1
IF G > (L) THEN G = 1
C$ = MID$(MESS$, G, 1)
CALL HEBLOC(HH, VV, C$)
DT$ = DT$ + C$


LOOP UNTIL T = 70

LOCATE 2, 2: PRINT DT$
END SUB

SUB UDCUR

IF X <> (X1) OR Y <> (Y1) THEN

CALL BOX(X1, Y1, BC)
X1 = X: Y1 = Y

END IF


CURTPX = CURTPX + 1

 CALL BOX(X, Y, CURTPX)

IF CURTPX >= 16 THEN CURTPX = 0

END SUB

SUB WORDLEARN (PA$, OUTPA$)



SELECT CASE (PA$)
  CASE IS = "KF"

   OUTPA$ = "EVERY"
 
  CASE IS = "KRY"
   OUTPA$ = "ROCKET"
  CASE IS = ""
   OUTPA$ = ""

END SELECT




END SUB

