Listing 1. StarTrek_Videos CanDo Deck


*************
* Deck "StarTrek_Videos"
* Time 19:45:51
* Date 11/01/93
*************

*************
* Card(s) in deck.
*  Card "StarTrek"
*************
* 1 Card(s), 1 were printed.
*************

*************
* Natural order of Cards
*  Card "StarTrek"
*************

*************
* Global Routine(s) in deck.
*  Routine "GetHelp"
*  Routine "NextRecord"
*  Routine "RefreshWindow"
*  Routine "Show Record"
*  Routine "SortTapeNum"
*************
* 5 Global routines(s), 5 were printed.
*************

*************
* Card "StarTrek"
  AfterAttachment ; used to be AfterStartup
    SetRGB 0,72,165,170
    SetRGB 2,0,210,231
    SetRGB 3,0,54,255
    Do "RefreshWindow"
  EndScript
  Window "UserWindow"
    Definition
      Origin 0,0
      Size 640,200
      Title "Star Trek Video Collection"
      NumberOfColors 4,102400
      WindowColors 0,1,0 ; Detail, Block, Background
      WindowObjects CLOSEBUTTON 
      WindowFlags ACTIVATE SEPARATESCREEN TOFRONT 
    EndScript
    OnCloseButton
      Quit
    EndScript
  EndObject
  TextField ".Show"
    Definition
      Origin 120,85
      Size 32,8
      Justification LEFT 
      MaxFieldLength 3
      InitialText ""
      Border DOUBLEBEVEL ,2,1 ; BorderStyle, MainPen, ExtraPen
    EndScript
    OnRelease
      SetObjectState ".Title",ON
    EndScript
    OnClick
      If ObjectState("Question")=TRUE
        Do "GetHelp","Show"
      EndIf
    EndScript
  EndObject
  TextField ".Title"
    Definition
      Origin 268,85
      Size 290,8
      Justification LEFT 
      MaxFieldLength 35
      InitialText ""
      Border DOUBLEBEVEL ,2,1 ; BorderStyle, MainPen, ExtraPen
    EndScript
    OnRelease
      SetObjectState ".Year",ON
    EndScript
    OnClick
      If ObjectState("Question")=TRUE
        Do "GetHelp","Title"
      EndIf
    EndScript
  EndObject
  TextField ".Year"
    Definition
      Origin 120,110
      Size 40,8
      Justification LEFT 
      MaxFieldLength 4
      InitialText ""
      Border DOUBLEBEVEL ,2,1 ; BorderStyle, MainPen, ExtraPen
    EndScript
    OnRelease
      SetObjectState ".Episode",ON
    EndScript
    OnClick
      If ObjectState("Question")=TRUE
        Do "GetHelp","Year"
      EndIf
    EndScript
  EndObject
  IntegerField ".Episode"
    Definition
      Origin 280,110
      Size 24,8
      Justification LEFT 
      MaxFieldLength 2
      Limits 0,30
      InitialInteger 0
      Border DOUBLEBEVEL ,2,1 ; BorderStyle, MainPen, ExtraPen
    EndScript
    OnRelease
      SetObjectState ".TapeNum",ON
    EndScript
    OnClick
      If ObjectState("Question")=TRUE
        Do "GetHelp","Episode"
      EndIf
    EndScript
  EndObject
  IntegerField ".TapeNum"
    Definition
      Origin 410,110
      Size 32,8
      Justification LEFT 
      MaxFieldLength 3
      Limits 0,100
      InitialInteger 0
      Border DOUBLEBEVEL ,2,1 ; BorderStyle, MainPen, ExtraPen
    EndScript
    OnRelease
      SetObjectState ".ShowNum",ON
    EndScript
    OnClick
      If ObjectState("Question")=TRUE
        Do "GetHelp","TapeNum"
      EndIf
    EndScript
  EndObject
  ImageButton "StarTrekBrush"
    Definition
      Origin 90,13
      Image "CanDo:Brushes/StarTrek.br"
      Highlight COMPLEMENT 
      ButtonFlags NONE 
    EndScript
    OnRelease
      Do "GetHelp","MasterIndex"
    EndScript
  EndObject
  AreaButton "Edit_Add"
    Definition
      Origin 26,174
      Size 90,16
      Border ROLLO ,2,1 ; BorderStyle, MainPen, ExtraPen
      Highlight COMPLEMENT 
      ButtonFlags NONE 
    EndScript
    OnRelease
      If ObjectState("Question")=TRUE
        Do "GetHelp","EditAdd"
      Else
        SetPrintFont "ruby",12
        SetPrintStyle SHADOW ,2,3
        SetPen 1,0
        SetDrawMode JAM2 
        If Mode="Edit"
          PrintText "Add ",63,176
          Let Mode="Add"
          DisableObject "Prev"
          DisableObject "Next"
          DisableObject "Delete"
          DisableObject "Sort"
          SetWindowTitle "Star Trek Video Collection: Adding Record #"||CurIndex+1
          SetText ".Title",""
          SetText ".Description",""
          SetObjectState ".Show",ON
        Else
          EnableObject "Prev"
          EnableObject "Next"
          EnableObject "Delete"
          EnableObject "Sort"
          ClearWindow ;unghost disabled buttons
          Do "RefreshWindow" ;redisplay text
          SetWindowTitle "Star Trek Video Collection: Editing Record #"||CurIndex
          Do "Show Record"
        EndIf
      EndIf
    EndScript
  EndObject
  ImageButton "Prev"
    Definition
      Origin 141,175
      Image "CanDo:Brushes/Left.br"
      Highlight COMPLEMENT 
      ButtonFlags NONE 
    EndScript
    OnRelease
      If ObjectState("Question")=TRUE
        Do "GetHelp","Prev"
      Else
        Let Tapes[CurIndex]=GetDBObjects        ;save curr record
        Let CurIndex=PreviousArrayIndex(Tapes,CurIndex)  ;get prev record
        If Not SearchFound                ;if no prev record
          Let CurIndex=LastArrayIndex(Tapes)      ;go to last record
        EndIf
        Do "Show Record"
      EndIf
    EndScript
  EndObject
  ImageButton "Next"
    Definition
      Origin 167,175
      Image "CanDo:Brushes/Right.br"
      Highlight COMPLEMENT 
      ButtonFlags NONE 
    EndScript
    OnRelease
      If ObjectState("Question")=TRUE
        Do "GetHelp","Next"
      Else
        Do "NextRecord"
      EndIf
    EndScript
  EndObject
  TextButton "Delete"
    Definition
      Origin 215,175
      Font "System",8 ; FontName, PointSize
      PrintStyle SHADOW ,2,3 ; Style, Pen1, Pen2
      TextColors 1,0,NORMAL  ; PenA, PenB, DrawMode
      Text " Del "
      Border BEVEL ,2,1 ; BorderStyle, MainPen, ExtraPen
      Highlight COMPLEMENT 
      ButtonFlags NONE 
    EndScript
    OnRelease
      If ObjectState("Question")=TRUE
        Do "GetHelp","Del"
      Else
        DeleteArrayEntry Tapes,CurIndex      ;delete record
        If VarType(Tapes[CurIndex])="Nothing"  ;see if last
          Let CurIndex=LastArrayIndex(Tapes)  ;find new last
        EndIf
        Do "Show Record"
      EndIf
    EndScript
  EndObject
  TextButton "Sort"
    Definition
      Origin 300,175
      Font "System",8 ; FontName, PointSize
      PrintStyle SHADOW ,2,3 ; Style, Pen1, Pen2
      TextColors 1,0,NORMAL  ; PenA, PenB, DrawMode
      Text " Sort "
      Border BEVEL ,2,1 ; BorderStyle, MainPen, ExtraPen
      Highlight COMPLEMENT 
      ButtonFlags NONE 
    EndScript
    OnRelease
      If ObjectState("Question")=TRUE
        Do "GetHelp","Sort"
      Else
        SortArray Tapes,INTEGER ,".SHOWNUM"
        Do "SortTapeNum"
        Let CurIndex=FirstArrayIndex(Tapes)    ;go to first record
        Do "Show Record"
      EndIf
    EndScript
  EndObject
  TextButton "Load"
    Definition
      Origin 447,175
      Font "System",8 ; FontName, PointSize
      PrintStyle SHADOW ,2,3 ; Style, Pen1, Pen2
      TextColors 1,0,NORMAL  ; PenA, PenB, DrawMode
      Text " Load "
      Border BEVEL ,2,1 ; BorderStyle, MainPen, ExtraPen
      Highlight COMPLEMENT 
      ButtonFlags NONE 
    EndScript
    OnRelease
      If ObjectState("Question")=TRUE
        Do "GetHelp","Load"
      Else
        Let FNold=FN
        Let FN=AskForFileName(FN,"Load a File")  ;get a filename
        If FN<>"" AND Exists(FN)        ;if file exists
          Dispose Tapes            ;del curr DB
          Let Tapes=LoadVariable(FN)      ;load it
          Let CurIndex=FirstArrayIndex(Tapes)  ;go to first record
          Do "Show Record"
        Else
          Let FN=FNold
        EndIf
      EndIf
    EndScript
  EndObject
  TextButton "Save"
    Definition
      Origin 517,175
      Font "System",8 ; FontName, PointSize
      PrintStyle SHADOW ,2,3 ; Style, Pen1, Pen2
      TextColors 1,0,NORMAL  ; PenA, PenB, DrawMode
      Text " Save "
      Border BEVEL ,2,1 ; BorderStyle, MainPen, ExtraPen
      Highlight COMPLEMENT 
      ButtonFlags NONE 
    EndScript
    OnRelease
      If ObjectState("Question")=TRUE
        Do "GetHelp","Save"
      Else
        Let FNold=FN
        Let FN=AskForFileName(FN,"Save a File")  ;get a filename
        If FN<>""
          SaveVariable Tapes,FN        ;save it
        Else
          Let FN=FNold
        EndIf
      EndIf
    EndScript
  EndObject
  AKey "Help"
    Definition
      QualifiersPressed NONE 
      KeyPressed HELP 
    EndScript
    OnUp
      Do "GetHelp","MasterIndex"
    EndScript
  EndObject
  IntegerField ".ShowNum"
    Definition
      Origin 543,110
      Size 16,8
      Justification LEFT 
      MaxFieldLength 1
      Limits 1,6
      InitialInteger 1
      Border DOUBLEBEVEL ,2,1 ; BorderStyle, MainPen, ExtraPen
    EndScript
    OnRelease
      SetObjectState ".Description",ON
    EndScript
    OnClick
      If ObjectState("Question")=TRUE
        Do "GetHelp","ShowNum"
      EndIf
    EndScript
  EndObject
  TextField ".Description"
    Definition
      Origin 8,150
      Size 624,8
      Justification LEFT 
      MaxFieldLength 100
      InitialText ""
      Border DOUBLEBEVEL ,2,1 ; BorderStyle, MainPen, ExtraPen
    EndScript
    OnRelease
      If Mode="Edit"
        Do "NextRecord"
      Else ;mode is Add
        Let CurIndex=CurIndex+1
        InsertArrayEntry Tapes,CurIndex
        Let Tapes[CurIndex]=GetDBObjects
        SetWindowTitle "Star Trek Video Collection: Adding Record #"||CurIndex+1
        SetText ".Title",""
        SetText ".Description",""
        SetObjectState ".Show",ON
      EndIf
    EndScript
    OnClick
      If ObjectState("Question")=TRUE
        Do "GetHelp","Description"
      EndIf
    EndScript
  EndObject
  TextButton "Question"
    Definition
      Origin 593,175
      Font "topaz",8 ; FontName, PointSize
      PrintStyle SHADOW ,2,3 ; Style, Pen1, Pen2
      TextColors 1,0,NORMAL  ; PenA, PenB, DrawMode
      Text " ? "
      Border BEVEL ,2,1 ; BorderStyle, MainPen, ExtraPen
      Highlight COMPLEMENT 
      ButtonFlags BUTTONTOGGLES 
    EndScript
  EndObject
  TextButton "Print"
    Definition
      Origin 370,175
      Font "System",8 ; FontName, PointSize
      PrintStyle SHADOW ,2,3 ; Style, Pen1, Pen2
      TextColors 1,0,NORMAL  ; PenA, PenB, DrawMode
      Text " Print "
      Border BEVEL ,2,1 ; BorderStyle, MainPen, ExtraPen
      Highlight COMPLEMENT 
      ButtonFlags NONE 
    EndScript
    OnRelease
      If ObjectState("Question")=TRUE
        Do "GetHelp","Print"
      Else
        Let ESC=HexToChars("1B")
        Let CR=HexToChars("0D")
        Let FF=ESC||"&l0H"
        Let Reset=ESC||"E"
        Let Pitch10=ESC||"(s10H"
        Let Pitch20=ESC||"(s20H"
        Let Bold=ESC||"(s3B"
        Let Normal=ESC||"(s0B"
        Let ItalOn=ESC||"(s1S"
        Let ItalOff=ESC||"(s0S"
        Let ULOn=ESC||"&d0D"
        Let ULOff=ESC||"&d@"
        Let SetCol25=ESC||"&a25C"
        Let SetCol40=ESC||"&a40C"
        Let SetCol45=ESC||"&a45C"
        Let SetCol55=ESC||"&a55C"
        Let LPI8=ESC||"&l8D"
        Let Index=FirstArrayIndex(Tapes)
        OpenFile "PAR:","P",WRITEONLY ,OLDFILE 
        FileWriteChars "P",LPI8
        Let NumTapes=0
        Loop
          FileWriteChars "P",Pitch10
          FileWriteLine "P",SetCol25||Bold||"Star Trek: The Video Catalog"||Normal||CR
          Nop ;FileWriteLine "P",CR
          FileWriteChars "P",Pitch20   ;set compressed
          Loop
            Let Number=Tapes[Index].TapeNum
            FileWriteLine "P",Bold||ULOn||"TAPE "||Number||Normal||ULOff||CR
            FileWriteLine "P",CR
            Loop
              FileWriteChars "P",Tapes[Index].ShowNum||". "
              FileWriteChars "P",Bold||ItalOn||Tapes[Index].Title||ItalOff||Normal
              FileWriteChars "P",SetCol40||Tapes[Index].Show
              FileWriteChars "P",SetCol45||Tapes[Index].Year||"-"
              FileWriteChars "P",Tapes[Index].Episode
              FileWriteLine "P",SetCol55||Tapes[Index].Description||CR
              Let Index=NextArrayIndex(Tapes,Index)
            Until Tapes[Index].TapeNum<>Number OR SearchFound=FALSE
            Let NumTapes=NumTapes+1
            If SearchFound=TRUE AND NumTapes//8<>0
              FileWriteLine "P",CR
              FileWriteLine "P",CR
            EndIf
          Until SearchFound=FALSE OR NumTapes//8=0
          FileWriteChars "P",FF
        Until SearchFound=FALSE
        FileWriteChars "P",Reset  ;reset printer
        Close "P"
      EndIf
    EndScript
  EndObject
* End of Card "StarTrek"
*************

*************
* Global routine "GetHelp"
  Let Node="StarTrek_"||Arg1
  Let ErrHelp=AskForHelp("CanDo:Decks/StarTrek.guide",Node)
* End of routine "GetHelp"
*************

*************
* Global routine "NextRecord"
  Let Tapes[CurIndex]=GetDBObjects      ;save curr record
  Let CurIndex=NextArrayIndex(Tapes,CurIndex)  ;get next record
  If Not SearchFound              ;if no next record
    Let CurIndex=FirstArrayIndex(Tapes)    ;go to first record
  EndIf
  Do "Show Record"
* End of routine "NextRecord"
*************

*************
* Global routine "RefreshWindow"
  SetPrintFont "ruby",12
  SetPrintStyle SHADOW ,2,3
  SetPen 1,0
  SetDrawMode JAM2 
  PrintText "Show",60,84
  PrintText "Title",205,84
  PrintText "Year",60,109
  PrintText "Episode #",180,109
  PrintText "Tape #",334,109
  PrintText "Show #",466,109
  PrintText "Description",8,135
  PrintText "Edit",63,176
  Let Mode="Edit"
  Nop
  SetPrintFont "Pica Wide",11
  SetPrintStyle BOLD EMBOSSED ,2,3
  SetPen 1,0
  SetDrawMode JAM1 
  PrintText "The Video Collection",164,39
  SetDrawMode JAM1 
  SetPen 2
  AreaRectangle 18,58,602,9
  SetPen 3
  AreaRectangle 23,59,593,7
  SetPen 1
  AreaRectangle 28,60,584,5
* End of routine "RefreshWindow"
*************

*************
* Global routine "Show Record"
  SetDBObjects Tapes[CurIndex]    ;show the record
  SetWindowTitle "Star Trek Video Collection:  Editing Record #"||CurIndex
  SetObjectState ".Show",ON      ;put cursor in Show Field
* End of routine "Show Record"
*************

*************
* Global routine "SortTapeNum"
  Let One=FirstArrayIndex(Tapes)
  Let CurBottom=LastArrayIndex(Tapes)
  Loop
    Let Two=NextArrayIndex(Tapes,One)
    Loop
      If Tapes[One].TapeNum>Tapes[Two].TapeNum
        Let Temp=Tapes[One]
        Let Tapes[One]=Tapes[Two]
        Let Tapes[Two]=Temp
      EndIf
      Let One=Two
      Let Two=NextArrayIndex(Tapes,Two)
    Until Two>CurBottom OR SearchFound=FALSE
    Let One=FirstArrayIndex(Tapes)
    Let CurBottom=PreviousArrayIndex(Tapes,CurBottom)
  Until CurBottom=One
* End of routine "SortTapeNum"
*************