/*

       /__/     /|     /     /     /__/
      /        / |    /     /     /
     /_/      /  |   /     /     /_/
    /        /   |  /     /     /
  _/__/ _/ _/    |_/ _/ _/ _/ _/ _/

  -> tHiz waZ cOdDeD bY E.N.I.F. <-

*/  

OPT OSVERSION=37           -> jen systém 2.x a vejš, nejsme žádný mejdla 

MODULE 'intuition/intuition', 'intuition/screens', 'dos/dos' -> pár modulů
                                -> se dicky hodí  

CONST                           -> konstanty:  
  WIN_FLAGS   = 6144,           -> okno backdrop, bez okrajů, ...  
  WIN_IDCMP   = IDCMP_MOUSEBUTTONS OR IDCMP_RAWKEY  -> čteme myš a klávesy 

DEF
  sptr = NIL:PTR TO screen,    -> ukazatel na strukturu SCREEN (obrazovku)
  wptr = NIL:PTR TO window,    -> ukazatel na okno
  exit = 0:LONG,               -> pomocná proměná (= 1 když chceme skončit)  

  textbuff = NIL:PTR TO CHAR,  -> ukazatel na text, který si načtem do paměti 
  textfile = NIL:LONG,         -> ukazatel na otvíraný soubor na disku
  textlen  = 0:LONG,           -> délka souboru "textfile" = spotřeba RAM
  textlines = 0:LONG,          -> kolik to má vlastně řádek (informačně)
  spage  = 0:LONG,     -> ukazatel na začátek aktuální stránky [znak č.] ...
  epage  = 0:LONG,     -> (právě zobrazený) a tohle na její konec [znak číslo]
  firstline = 0:LONG,          -> první řádka stránky [řádka číslo.]
  lastline = 0:LONG,           -> poslední řádka stránky   
  sline = 0:LONG,              -> pomocné proměnné
  eline = 0:LONG,

  toptext = 1:LONG,            -> jsme-li na začátku textu pak = 1, jinak 0
  bottomtext = 0:LONG,         -> jsme-li na konci textu pak = 1, jinak 0

  linebuff[81]:STRING,         -> řetězec obsahující právě tištěnou řádku

  ev:LONG                      -> sem zachytávám události od systému

/*----------------------------------------------------------------------------------------------*/

-> tak tady to začíná...

PROC main()
DEF myargs:PTR TO LONG, rdargs  -> čtení argumentů bude dle os 2.x 

  myargs := [0, 0]   -> příprava listu na argumenty  
  IF (rdargs := ReadArgs('SOURCE/A', myargs, NIL)) -> a jejich čtení 
    IF opengui()                -> otevření obrazovky a okna 
      IF loadtext(myargs[0])    -> načtení textu do paměti   
        setuptext()             -> předzpracování textu
        fillscreen(textbuff, spage, epage) -> zobrazení první stránky  

        REPEAT                  -> čtení akcí uživatele  
          ev := WaitIMessage(wptr)  -> dáme mu čas :-) = čekání na událost 
          SELECT ev                 -> už se rozhoupal!
          CASE IDCMP_RAWKEY         -> klávesnice v akci
            evalkeys(MsgCode())     -> kouknem, co to vlastně zmáčk    
          CASE IDCMP_MOUSEBUTTONS   -> tak s myškou jsme si hráli...
            exit := 1               -> hm, tak  teda konec, no.   
          ENDSELECT
          ev := NIL                 -> zbytečnej (?) sichr 
        UNTIL exit = 1              -> dokud exit není 1...
      ENDIF
    ENDIF
  ELSE
    error('No file specified!')     -> uživatel nezadal žádný argumenty!
  ENDIF

  close_gui()                 -> všechno po sobě zavřeme
  flushtext()                 -> uvolníme paměť s nahraným textem
  CleanUp(0)                  -> a zavoláme Viktora Čističe...    
ENDPROC

PROC opengui()
DEF er = 0                       -> jen berlička     
init_screen()                    -> otevření obrazovky (640, 256, 1)  
IF sptr                          -> podařilo se?  
  init_window()                  -> otevření okna (640, 256, BACKGROUND + NOBORDERS) 
  IF wptr                        -> máme ho?   
    er := 1                      -> vše OK     
  ELSE                           -> jinak... 
    error('Could not open window!')  -> zařvem!  
  ENDIF
ELSE                             -> bez obrazovky...  
  error('Could not open screen!')     -> koušem!  
ENDIF
ENDPROC er                       -> vrátíme "er" pro testování v IF  

-> procedura na otvírání obrazovky kulturním způsobem
PROC init_screen()
  IF sptr:=OpenScreenTagList(NIL,                   -> systémová funkce 
                              [SA_PENS, [-1]:INT,   -> workbench barvy
                               SA_DEPTH, 1,         -> jenom dvě   
                               SA_DISPLAYID, $8000, -> PAL HIRES  
                               NIL])                -> konec tagů
    sptr.detailpen := 1                             -> nastavení barev,
    sptr.blockpen  := 0                             -> zcela nepodstatné 

    SetColour(sptr,0,  0,  0, 0)       -> éčkovská funkce pro nastavení barev 
    SetColour(sptr,1,200,200,200)      -> RGB, to pro zjednodušení, jinak vždy  
  ENDIF                                -> LoadRGB32() a pod.! 
ENDPROC

-> prozměnu nekulturní způsob otevření okna (OpeWindowTags() je lepší!)!
PROC init_window()
  wptr:=OpenW(0, 0, 640, 256, WIN_IDCMP, WIN_FLAGS, NIL, sptr, $F, NIL)
  IF wptr                 -> otevřeno dokořán? 
    wptr.detailpen := 1   -> nastavíme barvičky 
    wptr.blockpen  := 0
    SetTopaz(8)           -> a narvem tam topaz (funkce éčka, brr) 
  ENDIF
ENDPROC

PROC close_gui()          -> chcípnem to hrozný gui  
  IF wptr
    CloseW(wptr)           /* uzavření okna */  
  ENDIF
  IF sptr
    CloseS(sptr)           /* uzavření obrazovky */  
  ENDIF
ENDPROC

PROC infoline()   -> zobrazuje horní informační řádku 
  Colour(0, 1)
  TextF(0, 6, ' UxMore v1.0 - (C) E.N.I.F.            lines \d[5], first = \d[5], last = \d[5] ', textlines, firstline, lastline)
  Colour(1, 0)
ENDPROC

PROC error(text)  -> je-li něco v pr..li, pak poslouží
DEF e:LONG        -> pomocná proměná  
  IF sptr AND wptr   -> máme-li gui nahozený  
    infoline()       -> zobrazíme informační řádku (pro pořádek) 
    Colour(1, 0)     -> nastavíme barvu pro text (aby bylo na to vidět)
    TextF(0, 18, '\s', text) -> vypíšeme chybové hlášení
    e := WaitIMessage(wptr)  -> počkáme na přečtení uživatelem (potvrdí myší
  ELSE                       -> nebo klávesnicí)  
    WriteF('\s\n', text)  -> jsme-li bez gui, vypíšem to do shellu (nebo hellu)
  ENDIF
ENDPROC

PROC flushtext()  -> vyhazuje text z paměti, viz New() & Dispose() v AE x. díl.
  IF textbuff <> NIL THEN Dispose(textbuff)
ENDPROC

PROC loadtext(name = NIL) -> nahraje soubor "name" do paměti
DEF er                    -> pomocná proměná   
  er := 0                 -> zatím ještě chyba 
  initvars()              -> počáteční nastavení některých glob. proměných
  textlen := FileLength(name) -> zjištění délky souboru (-1 = soub. neexistuje) 
  IF textlen <> -1            -> existence souboru potvrzena  
    IF textbuff := New(textlen)  -> zkusíme si pro něj vyhradit paměť 
      IF textfile := Open(name, OLDFILE)   -> máme paměť, otevřem ho  
        IF Read(textfile, textbuff, textlen)  -> otevřen, čteme 
          er := 1           -> je v paměti, tak je to OK  
        ELSE
          error('Could not read file!')  -> bléé, nejde to číst!
        ENDIF
      ELSE
        error('Could not open file!') -> fuj, dyk to néde votevřít!
      ENDIF
    ELSE
      error('Could not allocate memory!') -> a kams dals paměť?
    ENDIF
  ELSE
    error('Could not find file!') -> kde je?
  ENDIF
ENDPROC er

PROC initvars()  -> přenastaví préměné na jejich počáteční hodnoty
  toptext := 1   -> prochu málo, na samostatnou proceduru :-) 
  bottomtext := 0   /* (jsme, na začátku textu)  */
ENDPROC

PROC setuptext() -> nalezne konec první strany textu a další 
DEF i
  i := 0         -> čítač projitých (nalezených) řádek  
  spage := -1    -> začátek stránky na -1 (viz priline)
  epage := 0     -> konec stránky na 0
  firstline := 1 -> řádkujeme od 1 
  WHILE (epage <= textlen) AND (i < 27) -> max. 27 řádek na stranu 
    epage := findnextchar(textbuff, epage, textlen, 10) -> najdi znak 10 (LF)
    i++
  ENDWHILE
  lastline := i - 1  -> poslední řádka je i - 1  
  IF epage = textlen THEN bottomtext := 1    -> jsme-li na konci textu
                                             -> (je-li krátkej) 
  textlines := countlines(textbuff, textlen) -> spočtem, kolik to má řádek
ENDPROC                                      -> pro informaci 

PROC priline(buffer, y, startpoz, len)    -> vytiskne řádku na x, y = 0, y 
DEF i, x, er = 1
   x := 0   -> index do řetězce buffer[] 
   i := startpoz + 1                      -> počátek čtení znaků v textu
   Colour(1, 0)                           -> nastavení barvy tisku
   WHILE (i < len) AND (buffer[i] <> 10)  -> do nejbliššího konce řádku (LF)
     IF x < 80             -> jen 80 znaků se vejde na obrazovku / do bufferu
       linebuff[x] := buffer[i]  -> kopie znaku z buferu do řetězce 
       x++
     ENDIF
     i++
   ENDWHILE
   linebuff[x] := 0              -> zakončení řetězce nulou 
   TextF(0, y, '\s', linebuff)   -> tisk řetězce 
   IF i = epage THEN er := 0     -> jsme-li na konci stránky vracíme nulu
ENDPROC er

PROC gotoup(buffer:PTR TO CHAR, len)  -> skok o řádek výš 
  eline := spage                      -> uložení začátku zobrazené stránky    
  spage := findprevchar(buffer, spage, 10) -> nalezení předchozího LF
  epage := findprevchar(buffer, epage, 10) -> -||- pro konec stránky 
  IF (spage < 0)                      -> jsme na začátku textu   
    toptext := 1
  ENDIF

  IF ((spage = 0) AND (buffer[0] = 10)) -> !*!*! tady je chyba !*!*!
    spage--
    toptext := 1      -> !*!*! tady je chyba - viz konec textu !*!*!  
    firstline--
  ENDIF                                 -> !*!*! tady je chyba !*!*!

  IF epage < len THEN bottomtext := 0   -> nejsme-li zároveň na konci textu
  firstline--                           -> snížení čísel zobrazované první 
  lastline--                            -> a poslední řádky 
  ScrollWindowRaster(wptr, 0, -9, 0, 9, 639, 251) -> posun obsahu okna dolů 
  priline (buffer, 16, spage, eline) -> vytištění nové řádky, která se objevila
                                     -> nahoře  
  infoline()                         -> zaktualizování informační řádky
ENDPROC

PROC gotodown(buffer:PTR TO CHAR, len) -> skok o řádku dolů 
  sline := epage                       -> uložení konce stránky  
  spage := findnextchar(buffer, spage, len, 10) -> najití dalších LF
  epage := findnextchar(buffer, epage, len, 10)
  IF epage = len THEN bottomtext := 1   -> konec textu - zarážka  
  IF spage > 0 THEN toptext := 0        -> nejsme na začátku textu?
  firstline ++                          -> zvýšení čísla první a poslední
  lastline ++                           -> řádky
  ScrollWindowRaster(wptr, 0, 9, 0, 9, 639, 251) -> skroll okna nahoru 
  priline (buffer, 16 + (9 * 26), sline, epage)  -> tisk spodní řádky
  infoline()    -> refresh informační řádky
ENDPROC

-> vyplní obrazovku textem (používá se jen na začátku programu) 
PROC fillscreen(buffer:PTR TO CHAR, stpoz, maxpoz)
DEF i, y
  y := 16

  infoline()
  vypsání 26 řádek (nebo méně - je-li text krátký)
  WHILE (y < 260) AND ((i := priline(buffer, y, stpoz, maxpoz)) <> 0)
    y := y + 9
    stpoz := findnextchar(buffer, stpoz, maxpoz, 10)
  ENDWHILE
ENDPROC

PROC countlines(buffer:PTR TO CHAR, len) -> spočte počet řádek v textu
DEF i, c, count = 0
  FOR i := 0 TO len - 1
    c := buffer[i]
    IF c = 10 THEN count++
  ENDFOR
ENDPROC count

-> nalezne další znak "ch"
PROC findnextchar(buffer:PTR TO CHAR, startpoz, len, ch)
DEF i
  IF startpoz < len                        -> nejsme-li na konci  
    i := startpoz + 1                      -> posun o jeden znak
    WHILE (buffer[i] <> ch) AND (i < len)  -> dokud znak nenaleznem 
      i++
    ENDWHILE
  ENDIF
ENDPROC i  -> vrať, kd jsme ho našli

-> to samé jako předchozí, ale pozpátku
PROC findprevchar(buffer:PTR TO CHAR, startpoz, ch)
DEF i
  IF startpoz > 0
    i := startpoz - 1
    WHILE (buffer[i] <> ch) AND (i > -1)
      i--
    ENDWHILE
  ENDIF
ENDPROC i

PROC evalkeys(code)  -> vyhodnocení stisklých kláves
DEF i
SELECT code
CASE 69     -> ESC 
    exit := 1
-> šipky
CASE 76     -> UP 
  IF toptext = 0      -> nejsme-li na začátku textu
    gotoup(textbuff, textlen)
  ENDIF
CASE 77     -> DOWN 
  IF bottomtext = 0   -> nejsme-li na konci textu
    gotodown(textbuff, textlen)
  ENDIF
CASE 79  -> LEFT 
  i := 1              -> 27 krát posun o řádku nahoru
  WHILE (toptext = 0) AND (i < 27)
    gotoup(textbuff, textlen)
    i++
  ENDWHILE
CASE 78 -> RIGHT
  i := 1              -> 27 krát posun o řádku dolů
  WHILE (bottomtext = 0) AND (i < 27)
    gotodown(textbuff, textlen)
    i++
  ENDWHILE
DEFAULT
  NOP                  -> pro zvýšení efektivity - NOP ;-)
ENDSELECT
ENDPROC

/*------------------------------------- END ----------------------------------------------------*/ 

vers: CHAR '$VER: UxMore 1.0 (09.09.1998) c E.N.I.F.',0   -> version STRING 

• příliž mnoho globálních proměných pro předávání dat mezi procedurami
   
  
• občas by nevadilo využít přímo služeb systému a ne funkcí éčka (tisk na obrazovku, otevírání oken, nastavování barev, ...)
   
  
• místy zvýšit přehlednost a efektivitu (proměnné "navíc" a divoké podmínky)
   
  
• odstranit velmi závažnou chybu, která se projeví když text začímá znakem řádkování (LF, ASCII 10). Co se stane? Prostě: když by se posun nahoru měl zarazit na začátku textu, nestanese tak a vy si prohlížíte nesmysly odkudsi z paměti, či co. Částečně jsem toto odstranil jednou podmínkou v gotoup() (viz komentáře, ale stále to dělá psí kusy...
   
  
• přidat další fukce (načtení dalšího textu bez ukončení programu, načtení více textů najednou, vyhledávání, skok na řádku číslo, ...)
   
  
• otvírat GUI až po načtení textu (ikdyž toto je sporné: buď si rozsekáte chipku otevřením obrazovky, nebo fastku (přesněji PUBLIC MEM) načtením textu...).
   
  
• cokoliv, co vás napadve!

 
Dvešní díl AE - Prakticky je u konce (já taky :-)). Loučím se: Má poklona, pardálové! a někdy příště čauky!

E.N.I.F.          

AMIGA E - V.díl

Vokecávky	Hardware	Warez	WBoviny	Dema	Gfx&Muz	Pařby	Vokecávky 2