' =============================================================================
'                   Source code: PowerBASIC for DOS
'
'           Author: Egbert Zijlema (e.zylema@castel.nl)
' Copyright status: Public Domain
'
' Routines to address the screen segment
' Related article at: http://www.basicguru.com/zijlema/peekpoke.htm
' =============================================================================

DEFINT A - Z
DIM ScrnSeg AS SHARED INTEGER, mono AS SHARED INTEGER

IF (pbvScrnCard AND 1) = 0 THEN
  ScrnSeg = &HB800
  ofs = 4096                                           ' initial scr. offset
  SCREEN 0, 0, 1, 0                                    ' invisible screen
ELSE
  ScrnSeg = &HB000
  mono = -1                                            ' yes, monochrome
  ofs = 0
END IF

CurtainData:
DATA 30, " OPEN YOUR CURTAINS "
DATA 20, "CURTAIN.BAS, demo version"
DATA 20, "This routine is freeware - it has been donated to"
DATA 20, "the public domain by the author"

CLS
  ' first, prepare invisible background screen
  ' note: on a monochrome card, preparation will be done on
  ' the default screen. Power Basic is fast enough,
  ' hopefully, to let it happen un-acknowledged (more or less?!)

  Box 10, 22, 6, 38, 15, 0
  LOCATE 12, 24 : PRINT "Program made by Egbert Zijlema"
  LOCATE 13, 24 : PRINT "http://www.basicguru.com/zijlema/"
  DEF SEG = ScrnSeg
  BackScreen$ = PEEK$(ofs, 3200)             ' save 20 rows of screen
  DEF SEG

  ' now prepare monochrome curtain (user might press F2)
  CLS                                        ' clear background screen
  Box 1, 1, 20, 80, 0, 7
  RESTORE CurtainData
  FOR DataCount = 1 TO 4
    READ column, text$
    IF DataCount = 1 THEN row = 0 ELSE row = 9
    COLOR 0, 7
    LOCATE DataCount + row, column : PRINT text$
  NEXT
  DEF SEG = ScrnSeg
  MonoCurtain$ = PEEK$(ofs, 3200)            ' 20 rows = enough
  DEF SEG

  SCREEN 0, 0, 0, 0                          ' switch to default screen

  IF ScrnSeg = &HB800 THEN                   ' prepare color curtain
    CLS
    Box 1, 1, 20, 80, 15, 1
    RESTORE CurtainData
    FOR DataCount = 1 TO 4
      READ column, text$
      IF DataCount = 1 THEN
        COLOR 1, 7
        row = 0
      ELSE
        COLOR 15, 1
        row = 9
      END IF
      LOCATE DataCount + row, column : PRINT text$
    NEXT
    DEF SEG = ScrnSeg
    curtain$ = PEEK$(0, 3200)
    DEF SEG
  ELSE
    curtain$ = MonoCurtain$                  ' make mono the default
    DEF SEG = ScrnSeg
    POKE$ 0, curtain$
    DEF SEG
  END IF
  UserMenu BackScreen$, curtain$, MonoCurtain$  ' start dummy menu
END

FUNCTION GetKey AS INTEGER
  DO
    DisplayTime
    DisplayKeyStatus
  LOOP UNTIL INSTAT
  FUNCTION = CVI(INKEY$ + CHR$(0))
END FUNCTION

SUB UserMenu(BackScreen$, curtain$, MonoCurtain$)
  COLOR 7, 0
  LOCATE 22, 1 : PRINT "Type a few characters: "
  LOCATE 23, 1 : PRINT "Toggle SCROLL, NUM, CAPS, INS"
  LOCATE 24, 1 : PRINT "Press F1 to draw curtain; F2 to toggle C/BW"
  LOCATE 25, 1 : PRINT "Press Alt-x to quit";

  LOCATE 22, 24, 1                             ' cursor ready for user
  DO
    KeyIn = GetKey
    SELECT CASE KeyIn
      CASE 59 * 256                            ' F1 pressed
        IF curtn THEN
          curtn = 0                            ' flag crtn closed
          CloseCurtain 2, 1, 18, 80, 40, curtain$
        ELSE
          curtn = -1                           ' flag curtn open
          OpenCurtain 2, 1, 18, 80, 40, BackScreen$, curtain$
        END IF
      CASE 60 * 256                            ' F2 pressed
        IF ScrnSeg = &HB000 THEN EXIT SELECT   ' toggle not allowed
        IF mono THEN mono = 0 ELSE mono = -1
        SWAP MonoCurtain$, curtain$
        DEF SEG = ScrnSeg
        POKE$ 0, curtain$
        DEF SEG
        IF curtn THEN  ' re-open it
          OpenCurtain 2, 1, 18, 80, 40, BackScreen$, curtain$
        END IF
      CASE 65 TO 90, 97 TO 122
        PRINT CHR$(KeyIn);                     ' print normal ascii
    END SELECT
  LOOP UNTIL KeyIn = 45 * 256                  ' until Alt-x pressed
  COLOR 7, 0 : CLS : SYSTEM
END SUB

SUB DisplayTime
  SELECT CASE mono
    CASE -1
      fg = 0  : bg = 7                     ' black on white
    CASE 0
      fg = 14 : bg = 4                     ' yellow on red
  END SELECT

  display$ = ColoredText(CHR$(32) + TIME$ + CHR$(32), fg, bg)
  DEF SEG = ScrnSeg                        ' load segment
  POKE$ 136, display$                      ' row 1, column 69
  DEF SEG                                  ' restore default segment
END SUB

SUB DisplayKeyStatus
  DIM lok$(4 : 7)
  DIM status AS BYTE
  bg = 7
  row = 24 * 160                           ' DOS-row 25
  IF mono THEN fg = 0 ELSE fg = 9
  lok$(4) = ColoredText(" SCROLL ", fg, bg)
  lok$(5) = ColoredText(" NUM ", fg, bg)
  lok$(6) = ColoredText(" CAPS ", fg, bg)
  lok$(7) = ColoredText(" INS ", fg, bg)
  status = LockStatus

  DEF SEG = ScrnSeg
  FOR count = 4 TO 7
    SELECT CASE count
      CASE 4 : offset = row + 106                 ' column 54
      CASE 5 : offset = row + 124                 ' column 63
      CASE 6 : offset = row + 136                 ' column 69
      CASE 7 : offset = row + 150                 ' column 76
    END SELECT
    IF BIT(status, count) THEN
      POKE$ offset, lok$(count)
    ELSE
      POKE$ offset, STRING$(LEN(lok$(count)), 0)  ' wipe out
    END IF
  NEXT
  DEF SEG
END SUB

FUNCTION LockStatus AS BYTE
  ! push DS
  ! mov  AH, 2
  ! int  &H16
  ! mov  FUNCTION, AL
  ! pop  DS
END FUNCTION

FUNCTION ColoredText(text$, fg, bg) AS STRING
  FOR char = 1 TO LEN(text$)
    temp$ = temp$ + _
            MID$(text$, char, 1) + _       ' first/next character
            MKBYT$(fg + (bg * 16))         ' add attribute
  NEXT
  FUNCTION = temp$
END FUNCTION

SUB Box(row, col, rows, cols, fgr AS BYTE, bgr AS BYTE)
  COLOR fgr, bgr
  LOCATE row, col : PRINT CHR$(201); STRING$(cols - 2, 205); CHR$(187);
  FOR count = row + 1 TO row + rows - 2
    LOCATE count, col
    PRINT CHR$(186); SPACE$(cols - 2); CHR$(186);
  NEXT
  LOCATE row + rows - 1, col
  PRINT CHR$(200); STRING$(cols - 2, 205); CHR$(188);
END SUB

SUB OpenCurtain(row, col, rows, cols, howmany, bg$, curtn$)
  ' row     = first row to open
  ' rows    = number of rows
  ' col     = utmost left column
  ' cols    = width of the screen to manipulate
  ' howmany = number of colums to "open"  - maximum = cols
  ' bg$     = backgroundscreen (prepared in advance)
  ' curtn$  = param (returns screen array in order to
  '           enable a proper close)

  DEF SEG = ScrnSeg
  curtn$  = PEEK$(0, 4000)                            ' save screen
  DEF SEG
  DO
    CurtainDelay                                      ' pause
    INCR offs, 2                                      ' step 2 for offset
    FOR count = row TO row + rows - 1
      offset = (count - 1) * 160 + (col - 1) * 2 + 2  ' screen offset
      bgof = offset + cols - 1 - offs                 ' offset for backgr
      temp$  = MID$( curtn$, offset + offs + 1, 2 * (cols - 2 - offs) )
      length = LEN(temp$) \ 2
      DEF SEG = ScrnSeg
      POKE$ offset, LEFT$(temp$, length) + _
                    MID$(bg$, bgof, 2 * offs) + _
                    RIGHT$(temp$, length)
      DEF SEG
    NEXT
  LOOP UNTIL offs = howmany
END SUB

SUB CurtainDelay
  start! = TIMER
  DO
    now! = TIMER
    IF now! < start! THEN INCR now!, 86400   ' midnight pass
  LOOP UNTIL now! > start!                   ' smallest possible difference
END SUB

SUB CloseCurtain(row, col, rows, cols, howmany, curtn$)
  DO
    CurtainDelay
    FOR count = row TO row + rows - 1
      offset = (count - 1) * 160 + (col - 1) * 2
      temp$  = MID$(curtn$, offset + howmany + 1, 2 * (cols - howmany))
      length = LEN(temp$) \ 2
      rofset = offset + length + 2 * (howmany - 1)

      DEF SEG = ScrnSeg
      POKE$ offset + 2, LEFT$(temp$, length)
      POKE$ rofset, RIGHT$(temp$, length)
      DEF SEG
    NEXT
    DECR howmany, 2
  LOOP UNTIL howmany = 0
END SUB