'===========================================================================
' Subject: SIDE WRITE FONTS                  Date: Unknown Date (00:00:00)
' Author:  Unknown Author(s)                 Code: QB, QBasic, PDS        
' Keys:    SIDE,WRITE,FONTS                Packet: GRAPHICS.ABC
'===========================================================================
DEFINT A-Z
DECLARE SUB SideWrite (Mot$, PosX, PosY, Couleur, Opt)  'this is for QB4 only

SCREEN 1                                            '320 x 200 x 4 graphics
DIM Temp(13)                                        'holds upper left corner
GET (0, 0)-(8, 7), Temp                             'save upper left corner

'SCREEN 9                                           '640 x 350 x 16 graphics
'DIM Temp(57)
'GET (0, 0)-(8, 13), Temp

CALL SideWrite("Side Writing", 0, 120, 1, 1)              '90ø up
CALL SideWrite("Italic Side Writing", 20, 160, 2, 2)      '90ø italic
CALL SideWrite("Vertical Writing", 40, 10, 3, 3)          '0ø down
CALL SideWrite("Side Writing", 55, 10, 1, 4)              '270ø down
CALL SideWrite("Italic Side Writing", 73, 10, 2, 5)       '270ø down italic
CALL SideWrite("Big Side Writing", 90, 190, 3, 6)         'big 90ø up
CALL SideWrite("Big Italic Side Writing", 115, 190, 1, 7) 'big 90ø up italic
CALL SideWrite("Big Vertical Writing", 145, 10, 2, 8)     'big 0ø down
CALL SideWrite("Normal", 10, 0, 3, 9)                     '0ø
CALL SideWrite("Normal Italic", 70, 0, 1, 10)             '0ø right italic
CALL SideWrite("Big ", 180, 0, 2, 11)                     'big 0ø right
CALL SideWrite("Big Italic", 220, 0, 3, 12)               'big 0ø right italic
CALL SideWrite("All This DEMO", 180, 50, 1, 10)
CALL SideWrite("was done", 195, 60, 2, 9)
CALL SideWrite("--> with <--", 180, 76, 3, 11)
CALL SideWrite("SideWrit.Bas!!", 180, 100, 1, 12)
CALL SideWrite("______________", 180, 102, 1, 12)

PUT (0, 0), Temp, PSET                              'restore upper left corner

SUB SideWrite (Mot$, PosX, PosY, Couleur, Opt) STATIC
FOR Nombre = 1 TO LEN(Mot$)
    LOCATE 1, 1
    PRINT MID$(Mot$, Nombre, 1)        'print word's letters one by one
    FOR X = 0 TO 7
      FOR Y = 0 TO 7                   'use 0 TO 13 for EGA
        IF POINT(X, Y) THEN            'read pixel on/off for sideways copy
           IF Opt = 1 THEN
              PSET (Y + PosX, 8 - X + PosY - (8 * Nombre)), Couleur
           ELSEIF Opt = 2 THEN
              PSET (Y + PosX, 8 - X + PosY - (8 * Nombre) + Y), Couleur
           ELSEIF Opt = 3 THEN
              PSET (X + PosX, PosY + (8 * Nombre) + Y), Couleur
           ELSEIF Opt = 4 THEN
              PSET (8 - Y + PosX, PosY + (8 * Nombre) + X), Couleur
           ELSEIF Opt = 5 THEN
              PSET (8 - Y + PosX, PosY + (8 * Nombre) + X - Y), Couleur
           ELSEIF Opt = 6 THEN
              PSET (Y + PosX + Y, 8 - X + PosY - (8 * Nombre)), Couleur
              PSET (1 + Y + PosX + Y, 8 - X + PosY - (8 * Nombre)), Couleur
           ELSEIF Opt = 7 THEN
              PSET (Y + PosX + Y, 8 - X + PosY - (8 * Nombre) + Y), Couleur
              PSET (1 + Y + PosX + Y, 8 - X + PosY - (8 * Nombre) + Y), Couleur
          ELSEIF Opt = 8 THEN
              PSET (X + PosX + X, PosY + (8 * Nombre) + Y), Couleur
              PSET (1 + X + PosX + X, PosY + (8 * Nombre) + Y), Couleur
           ELSEIF Opt = 9 THEN
              PSET (X + PosX + (Nombre * 8), PosY + Y), Couleur
           ELSEIF Opt = 10 THEN
              PSET (X + PosX + (Nombre * 8) - Y, PosY + Y), Couleur
           ELSEIF Opt = 11 THEN
              PSET (X + PosX + (Nombre * 8), PosY + Y + Y), Couleur
              PSET (X + PosX + (Nombre * 8), 1 + PosY + Y + Y), Couleur
           ELSEIF Opt = 12 THEN
              PSET (X + PosX + (Nombre * 8) - Y, PosY + Y + Y), Couleur
              PSET (X + PosX + (Nombre * 8) - Y, 1 + PosY + Y + Y), Couleur
           END IF
        END IF
      NEXT Y
    NEXT X
NEXT Nombre
END SUB