Hatupist - teemme ohjelman kirjoitusnopeusharjoitteluun

[snifi]

Tänään yritän saada alkuun asetusikkunan luonnin. Puunäkymän solujen arvon muuttaminen osoittautui vaikeammaksi kuin oletin, joten luvassa on ainoastaan osittaistoteutus tällä kertaa.

Asetusikkunan tarkoituksena on antaa käyttäjälle mahdollisuus muokata Settings-tietorakenteeseen kuuluvia kenttiä kuten aloitusriviä tai rivinpituutta. Kirjasimen ja kertomustiedoston valinnan olemme hoitaneet jo päävalikon kautta, mutta lisänä asetuksiin tulisi nyt avustavaan näppäimistöön liittyvät valinnat, kuten näppäimistöjärjestys.

Tietorakenne Settings on kuvattuna seuraavassa:

Koodia: [Valitse]

data Settings = Settings {
  startLine :: Int,
  lineLen :: Int,
  textfile :: String,
  font :: String,
  useHelper :: Bool,
  helperDelay :: Int,
  keyboard :: [String]
} deriving (Read, Show)

Ikkunan puunäkymää varten määrittelemme seuraavan taulukon:

Koodia: [Valitse]

settingsTable = [
  ["Aloitusrivi", show (startLine gss)],
  ["Rivinpituus (mrk)", show (lineLen gss)],
  ["Näytä näppäimistö", show (useHelper gss)],
  ["Avustajan viive (ms)", show (helperDelay gss)],
  ["Näppäimistön ylärivi", keyboard gss !! 0],
  ["Näppäimistön keskirivi", keyboard gss !! 1],
  ["Näppäimistön alarivi", keyboard gss !! 2] ]

Ja ruudulla tämä näyttää lopulta tältä:



Näkymä luodaan samaan tapaan kuin aikaisemmin, mutta sarakenumero i välitetään parametrina.

Koodia: [Valitse]

  mapM
    ( \(title, i) -> newcol view model title i )
    ( zip colTitle [0..] )

Sarakenumeron ollessa 1, solusta tehdään muokattava:

Koodia: [Valitse]

      cellLayoutSetAttributes col renderer model (
        \row -> [ cellText := row !! i, cellTextEditable := (i==1) ])

Ja muokkauksen päättyessä kutsuttavan tapahtumankäsittelijän määrittelemme funktiossa onCellEdited. Parametri path oli minulle hieman mysteerinen, mutta kokeiluiden jälkeen se osoittautui muokkauksen rivinumeron sisältäväksi yksialkioiseksi taulukoksi.

Koodia: [Valitse]

      on renderer edited (onCellEdited model)

onCellEdited model path newText = do
  let i = head path
  [key,oldText] <- listStoreGetValue model i
  listStoreSetValue model i [key,newText]
  print (path, i, key, oldText, newText)

Tulostaen esimerkiksi

Koodia: [Valitse]

([0],0,"Aloitusrivi","0","67")
([2],2,"N\228yt\228 n\228pp\228imist\246","True","False")
([4],4,"N\228pp\228imist\246n yl\228rivi","qwertyuiop\229","qwertyuiop\229")

Käyttäjän antaman syötteen oikeellisuus on vielä tarkistettava, mutta teemme sen seuraavalla kerralla. Asetusikkunaan liittyvän ohjelmakoodin olen toistaiseksi pitänyt erillään pääohjelmasta (Koodaus on jälleen UTF-8):

http://personal.inet.fi/koti/jhii/asetukset-03.hs

[snifi]

Asetuksissa on kolmen tyyppisiä arvoja: Siellä on kokonaislukuja (Int), totuusarvoja (Bool) ja merkkijonoja (String). Tehtävänämme on nyt jäsentää puunäkymän taulukossa esiintyvä merkkijono oikeaan muotoon. Näistä merkkijonon jäsentäminen merkkijonoksi on triviaali. Merkkijonon jäsentäminen kokonaisluvuksi onnistuu esimerkiksi määrittelemällä seuraava funktio:

Koodia: [Valitse]

readInt :: String -> IO Int
readInt s = readIO s

Vastaavasti merkkijonon jäsentäminen totuusarvoksi (True tai False) tapahtuu funktiolla

Koodia: [Valitse]

readBool :: String -> IO Bool
readBool s = readIO s

Tällä kertaa haluamme kuitenkin tehdä täysin suomenkielisen version totuusarvosta, joten määrittelemme tyypin K/E-arvoille, joka tulostetaan muodossa Kyllä/Ei:

Koodia: [Valitse]

data KBool = K | E deriving (Read)

instance Show KBool where
  show K = "Kyllä"
  show E = "Ei"

Käyttäjän antamaan merkkijonoon s lisätään tyhjä välilyönti, jotta funktio head voi kaikissa tapauksissa ottaa tuosta merkkijonosta ensimmäisen merkin. Tämä merkki muunnetaan suuraakkosiksi ja listakonstruktorilla [] takaisin merkkijonoksi, jonka jälkeen se voidaan tuttuun tapaan jäsentää funktiolla readIO:

Koodia: [Valitse]

readKBool :: String -> IO KBool
readKBool s = readIO [toUpper (head (s ++ " "))]

Nyt siis puunäkymän sisältö muunnetaan listaksi, joka koostuu alilistoista, jonka alkiot ovat Muuttuja ja Arvo. Tämä lista kokonaisuudessaan syötetään funktiolle tryFunc, joka sisältää tarvittavan suojauksen virheellisen syötteen varalle. Jos jäsentäminen onnistuu, palautetaan uusi Settings-rakenne, jonka kenttiä ovat puunäkymän listan alkiot. Jos jäsentäminen epäonnistuu, palautetaan vanha Settings-rakenne:

Koodia: [Valitse]

v lst i = (lst !! i) !! 1

tryFunc g lst = do
  opResult <- try ( do
  a <- readInt (v lst 0)
  b <- readInt (v lst 1)
  c <- readKBool (v lst 2)
  d <- readInt (v lst 3)
  return g {
    startLine = a,
    lineLen = b,
    useHelper = c,
    helperDelay = d,
    keyrow1 = v lst 4,
    keyrow2 = v lst 5,
    keyrow3 = v lst 6
  }
  )
  case opResult of
    Left excp -> return g
    Right val -> return val

Takaisinkutsufunktion onCellEdited työvaiheet ovat seuraavat: Luetaan globaalit muuttujat. Vanhaan tapaan selvitetään mikä rivi on muuttunut. Luetaan tuon rivin Muuttuja-alkio ja sitä vastaava entinen Arvo-alkio. Asetetaan Arvo-alkioon käyttäjän syöttämä uusi teksti. Muunnetaan koko taulukko listaksi. Lähetetään lista funktion tryFunc jäsennettäväksi. Päivitetään taulu jäsennyksen tuloksella ja kirjoitetaan tulos takaisin globaaliin muuttujaan:

Koodia: [Valitse]

onCellEdited gsRef model path newText = do
  gs <- readIORef gsRef
  let i = head path
  [key,oldText] <- listStoreGetValue model i
  listStoreSetValue model i [key,newText]
  lst <- listStoreToList model
  newS <- tryFunc (s gs) lst
  refreshSettingsTable model newS
  writeIORef gsRef gs { settings = newS}

Haskell-kielen kaltaisella vahvasti tyypitetyllä kielellä erilaisia tyyppejä sisältävän taulukon käsittely ei ole helppoa. Tästä syystä tämänkertainen koodi on sekavaa, ja parempiakin tapoja varmasti löytyisi.

Asetusdialogin ohjelmakoodi: http://personal.inet.fi/koti/jhii/asetukset-04.hs

[snifi]

Tänään parantelemme hieman väri-indikaattoria, joka kertoo kuinka korkealle tuloksissa saavutettu tulos sijoittuu. Ennalta määriteltyjen värien sijasta haluamme käyttää itse määriteltävää funktiota.

Logaritmifunktio vaikuttaa edelleen parhaalta valinnalta tehtävään. Sen avulla hyvät tulokset erottuvat joukosta ja huonoja tuloksia saadaan mahtumaan mitta-asteikolle (sananmukaisesti) eksponentiaalinen määrä.

Käytettävän funktion ollessa 2^x, saadaan seuraava taulukko:

Koodia: [Valitse]

$ ghci
Prelude> [2^x | x <- [0..12]]
[1,2,4,8,16,32,64,128,256,512,1024,2048,4096]

Viidentuhannen tuloksen taulukko saadaan siten funktiota logBase 2.0 käyttäen kuvautumaan noin kolmelletoista värille, joka lienee hyvä valinta tässä vaiheessa. Koska sopivan värivalikoiman löytäminen RGB-asteikolta on kohtuu vaikeaa, kokeilemme tämän sijasta HSV-väriasteikkoa, joka löytyy GTK-kirjastoista valmiina. Annamme Hue-parametrin kulkea väriasteikon lävitse, ja säädämme Value-parametrin pienenemään sitä mukaan kun tulokset huononevat, jolloin värin valoisuus heikkenee ja lähestymme tummia violetin, ruskean ja mustan sävyjä.

Teorian kokeilemiseksi laadimme pienen ohjelman, jonka tulos näkyy kuvassa:



Ohjelmakoodi on löydettävissä osoitteesta
http://personal.inet.fi/koti/jhii/variteemat-03.hs

[snifi]

Olen tähän viimeisimpään versioon koonnut tekemämme asetusdialogin, näppäimistöavustajan aloittelijoille ja tuon paljon vaivannäköä sisältäneen väri-indikaattorin (josta siitäkin kuvankaappausohjelma näkyy syöneen pätkän pois).

Ohjelmakoodissa on lisäksi korjattuna määrittelemämme Kyllä/Ei-tyyppi, joka sellaisenaan ei tietenkään toiminut, sillä jäsentämisen onnistumiseksi tyypin instanssien luokille Read ja Show tulee olla toistensa kanssa yhteneväiset.

Aikaisemmassa ohjelmassa käytin TextView-komponenttia tekstikenttänä, koska sen asettelut osuivat paremmin yhteen Label-komponenttien kanssa enkä tuolloin löytänyt sopivaa tapahtumankäsittelijää muuttuneelle syötteelle. Tässä versiossa komponentti on korvattu Entry-komponentilla, joka on paremmin yhden rivin syötteelle sopiva.



Koodista muutokset löytyvät pääosin hakusanalla Entry, mutta tässä muutama esiteltynä:

Koodia: [Valitse]

miscSetPadding label1 2 0
Label-komponenttien sisennys on kaksi pikseliä, jolloin tekstit asettuvat täsmällisesti allekkain.

Koodia: [Valitse]

entrySetHasFrame entry False
Poistaa Entry-komponentin hankalan kehyksen.

Koodia: [Valitse]

entrySetText (gEntry (g gs)) ""
Tyhjentää syöterivin.

Koodia: [Valitse]

txt <- entryGetText (gEntry (g gs))
Lukee tekstin syöteriviltä.

Koodia: [Valitse]

onEditableChanged entry (
  whenEntryChanged gsRef)
Tapahtumankäsittelijä löytyi komponentin toteuttamasta Editable-liittymästä, ei siis suoraan Entry-luokan metodeista.

Ohjelmakoodi kokonaisuudessaan: http://personal.inet.fi/koti/jhii/entry-01.hs

[snifi]

Muutettaessa ohjelman asetuksia täytyy tehdä tekstirivien suhteen muutama toimenpide:
Jos rivinpituutta muutetaan, on teksti luettava uudestaan ja rivitettävä uuteen pituuteen. Voidaan käyttää samaa funktiota, jolla teksti alunperin luettiin.
Jos aloitusriviä muutetaan, on ruudulla näkyvät tekstirivit päivitettävä.
Lisäksi periaatteessa rivinpituuden muuttaminen aiheuttaa sen, että aloitusrivi ei ole kovinkaan voimassaoleva. Se pitäisi ehkä nollata tai laskea uudestaan, mutta jätettäköön nyt tekemättä.

Asetusten muuttamiseen tarkoitettu funktio näyttää tämän korjauksen jälkeen seuraavalta:

Koodia: [Valitse]

setPreferences gsRef = do
  oldGs <- readIORef gsRef
  result <- preferencesDialog "Asetukset" oldGs gsRef
  case result of
    Just "OK" -> do
      newGs <- readIORef gsRef
      when ((lineLen   (s oldGs)) /= (lineLen   (s newGs))) (getLines gsRef)
      when ((startLine (s oldGs)) /= (startLine (s newGs))) (renewLabels gsRef)
      afterConfig gsRef
    otherwise -> do
      writeIORef gsRef oldGs

Tässä Just "OK" on dialogi-ikkunan palauttama Maybe-tyypin arvo silloin kun käyttäjä hyväksyy tekemänsä muutokset painamalla OK-näppäintä. Muussa tapauksessa palautetaan vanhat asetukset, eikä tehdä muita toimenpiteitä.

Ohjelmakoodi kokonaisuudessaan: http://personal.inet.fi/koti/jhii/korjauksia-01.hs

Ajatuksenani oli vielä piirrellä grafiikoita tulosten kehityksestä ajan kuluessa, ehkä palaamme siihen vielä myöhemmin.

[snifi]

Kirjastomuutosten myötä ohjelma näkyy menneen toimimattomaksi. Kirjastoon Graphics.UI.Gtk on tullut uusi tietotyyppi Settings, jota nimeä käytettiin myös ohjelmassa. Päällekkäisyyden korjaamiseksi piilotetaan tietotyyppi:

Koodia: [Valitse]

import Graphics.UI.Gtk hiding (Settings)

Funktiota hsvToRgb ei enää tarvitse erikseen tuoda kirjastosta Graphics.UI.Gtk.Selectors.HSV, joten poistetaan se luettelosta.

Virheenkäsittely on siirtynyt kirjastoon Control.Exception, jolloin käytämme funktion try sijasta funktiota catch poikkeusten käsittelyyn. Se yksinkertaistaa melkoisesti ainakin seuraavia kolmea funktiomäärittelyä:

Koodia: [Valitse]

structFromFile fname pFunc zero = do
  content <- readFile fname `catch`
    \(SomeException e) -> return ""
  result <- pFunc content `catch`
    \(SomeException e) -> return zero
  return result

tryReadFile fname = do
  text <- readFile fname `catch`
    \(SomeException e) -> ( do
      dialog <- messageDialogNew Nothing [] MessageWarning ButtonsOk
        "Avaa tiedosto"
      messageDialogSetSecondaryText dialog
        ("Tiedostoa " ++ fname ++ " ei voitu lukea.")
      dialogRun dialog
      widgetDestroy dialog
      return (unlines proverbs))
  return text

onCellEdited gsRef model path newText = do
  gs <- readIORef gsRef
  let i = head path
  [key,oldText] <- listStoreGetValue model i
  listStoreSetValue model i [key,newText]
  lst <- listStoreToList model
  newS <- tryFunc (s gs) lst `catch`
    \(SomeException e) -> return (s gs)
  refreshSettingsTable model newS
  writeIORef gsRef gs { settings = newS }

Ohjelmakoodin uusin versio löytyy nyt täältä: http://personal.inet.fi/koti/jhii/korjauksia-02.hs

Ilman aikaisempia asennuksia ohjelman kääntämiseksi riittänee pakettien ghc, ghc-gtk ja ghc-gtk-devel asentaminen pakettivarastosta. Käännösohjeet tämän viestiketjun vastauksessa #17.

[snifi]

Gtk:n omien piirtorutiinien sijasta voidaan käyttää myös piirtokirjastoa  Graphics.Rendering.Cairo. Pyrin jatkossa tekemään kaikki ohjelman piirtorutiinit sen avulla. Kirjastoon tutustumiseksi piirretään tällä kertaa muutama varsinaiseen ohjelmaan liittymätön "testikuva".

Funktiolla frameNew luodaan kehys, jota voi käyttää vaikkapa kuvan nimeämiseen. Sen merkitys on lähinnä koristeellinen. Kehyksen sisälle luodaan piirtoalue funktiolla drawingAreaNew. Sen koko määritellään funktiolla widgetSetSizeRequest.

Koodia: [Valitse]

createFrame title func container = do
  frame <- frameNew
  frameSetLabel frame title
  boxPackStart container frame PackGrow 0
  drawingArea <- drawingAreaNew
  widgetSetSizeRequest drawingArea 200 150
  containerAdd frame drawingArea
  onExpose drawingArea (exposeHandler drawingArea func)

Kuvion piirtäminen tapahtuu onExpose-tapahtumankäsittelijässä. Sitä kutsutaan aina kun ikkunointijärjestelmä tuntee tarvetta uudelleenpiirtää komponentin. Uudelleenpiirtoa on mahdollista myös erikseen pyytää funktiolla widgetQueueDraw. Komponentin leveys ja korkeus saadaan funktiolla widgetGetSize, ja nämä tiedot välitetään komponentin piirtofunktiolle renderWithDrawable. Palautusarvo True kertoo, että tapahtuma on tullut käsitellyksi eikä se vaadi enää toimenpiteitä.

Koodia: [Valitse]

exposeHandler widget func e = do
  drawWin <- widgetGetDrawWindow widget
  (wi,hi) <- widgetGetSize widget
  let (w,h) = (intToDouble wi, intToDouble hi)
  renderWithDrawable drawWin (func w h)
  return True

Tämänkertaiset kolme kuviota ovat toteutukseltaan hyvin samankaltaisia. Kaikissa niissä käydään lävitse annettu värilista, ja piirretään kutakin väriä vastaava pystypalkki. Käytettävät piirtofunktiot ovat suorakulmion piirtävä rectangle, lähdevärin asettava setSourceRGB ja suorakulmion lähdevärillä täyttävä fill.

Taulukko framelist sisältää tietueet, joiden ensimmäinen alkio on kehyksen otsikko ja toinen piirtofunktio.

Koodia: [Valitse]

framelist = [
  ("Kuva 1", draw1),
  ("Kuva 2", draw2),
  ("Kuva 3", draw3)]

Ohjelmakoodi löytyy täältä: http://personal.inet.fi/koti/jhii/frames-02.hs ja sen tuottama ikkuna näyttää tältä:

[snifi]

Tarkoituksena on siis piirtää tuloksista kuvaaja. Merkkipisteen kuvio olkoon yksinkertainen ruksi. Sen polku koostuu neljästä symmetrisestä sakarasta, joista kukin piirretään seuraavan mallin mukaisesti:



Kunkin sakaran jälkeen tasoa pyöräytetään 90 astetta ja piirretään seuraava sakara. Lopuksi polku suljetaan funktiolla closePath ja täytetään annetulla värillä (brickRed4), jonka läpinäkyvyydeksi määritellään 0.5.

Koodia: [Valitse]

oneWing cr cb = do
  lineTo (-cb) (cb+cr)
  lineTo   cb  (cb+cr)
  lineTo   cb   cb
  rotate (-pi/2)

drawOneCross cr cb (r,g,b) = do
  moveTo (-cb) cb
  forM_ [1..4] (\x -> (oneWing cr cb))
  closePath
  setSourceRGBA r g b 0.5
  fill

Ruksia piirrettäessä pinnan origo siirretään pisteeseen (x,y) funktiolla translate. Ennen siirrosta Render-monadin tila otetaan talteen funktiolla save ja se palautetaan takaisin piirron jälkeen funktiolla restore.

Koodia: [Valitse]

brickRed4 = (0.886, 0.031, 0.000)

drawCrossAt x y = do
  save
  translate x y
  drawOneCross 3.0 1.0 brickRed4
  restore

Kuvaajan pisteet määritellään funktiossa pointsOnScreen. Tässä esimerkissä pisteet saadaan funktiosta sin x, missä x kulkee yhden täysympyrän matkan. Lähtö- ja palautusarvot ovat siis pieniä lukuja läheltä origoa. Kuvaajan piirtämiseksi lisätään marginaalit ja lähtö- ja palautusarvot skaalataan kuvan koon mukaisesti.

Koodia: [Valitse]

draw1 w h = do
  clearBgWhite w h white
  forM_ (pointsOnScreen w h) (\(x,y) -> drawCrossAt x y)

pointsOnScreen screenMaxX screenMaxY =
  [(posX x, posY y) | (x,y) <- values]
  where
    posX x = factorX*(x-valMinX) + margin
    posY y = (screenMaxY - margin) - factorY*(y-valMinY)
    factorX = screenDifX / valDifX
    factorY = screenDifY / valDifY
    screenDifX = max (screenMaxX - 2*margin) epsilon
    screenDifY = max (screenMaxY - 2*margin) epsilon
    margin = 0.1 * min screenMaxX screenMaxY
    valDifY = max (valMaxY - valMinY) epsilon
    valDifX = max (valMaxX - valMinX) epsilon
    valMinY = minimum [y | (x,y) <- values]
    valMaxY = maximum [y | (x,y) <- values]
    valMinX = minimum [x | (x,y) <- values]
    valMaxX = maximum [x | (x,y) <- values]
    values = [(x, sin x) | x <- [0,delta..2*pi]]
    delta = 2*pi/100
    epsilon = 0.01

Ohjelmakoodi löytyy täältä: http://personal.inet.fi/koti/jhii/ruksit-01.hs ja sen tuottama ikkuna näyttää tältä:

[snifi]

Piirretään vielä mitta-asteikot ja selitteet. Mitta-asteikkoa varten tarvitaan minimi- ja maksimiarvot kuvaajasta. Ne periaatteessa laskettiin jo viimeksi.

Koodia: [Valitse]

    valMinY = minimum [y | (x,y) <- values]
    valMaxY = maximum [y | (x,y) <- values]
    valMinX = minimum [x | (x,y) <- values]
    valMaxX = maximum [x | (x,y) <- values]

Ruksien sijainnin sisältävän listan lisäksi funktio pointsOnScreen voidaan laittaa palauttamaan myös mitta-asteikon sijainti ja selitetekstit. Mitta-asteikon etäisyydeksi määritellään tässä 15 pikseliä kuvaajasta.

Koodia: [Valitse]

pointsOnScreen screenMaxX screenMaxY values =
  ([(posX x, posY y) | (x,y) <- values],
   ([(x1-15,y1),(x1-15,y2)], [(x1,y2+15),(x2,y2+15)],
   (valMinX,valMaxX,valMinY,valMaxY)))

Nämä sijoitetaan muuttujaan legends ja piirretään mustalla värillä funktiossa drawLegend.

Koodia: [Valitse]

draw1 w h values = do
  clearBgWhite w h white
  let (crosses, legends) = pointsOnScreen w h values
  forM_ crosses (\(x,y) -> drawCrossAt x y)
  drawLegend legends black

Funktio drawLegend piirtää ensin pystysuuntaisen asteikon. Sen pääakseli on pystyviiva pisteestä (x1,y1) pisteeseen (x2,y2).

Koodia: [Valitse]

  moveTo x1 y1
  lineTo x2 y2

Pääakselin kylkeen piirretään kuvan koon mukaisesti lyhyet poikittaiset viivat. Niitä vastaava tekstin paikka ja kirjasin asetetaan funktiossa manipulateText. Aktiivinen päätepiste siirretään poikkiviivan kärjestä vähän etäämmälle funktiolla relMoveTo ja teksti piirretään funktiolla showLayout. Tässä esimerkissä ei ole erityisesti kiinnitetty huomiota selitteiden ulkonäön viimeistelyyn.

Koodia: [Valitse]

  forM_ yLegendsExtra (\((x,y),str) -> do
    moveTo (x+ww) y
    lineTo (x-tickW) y
    layout <- createLayout (f01 str)
    (dx,dy) <- liftIO (manipulateText layout Vertical)
    relMoveTo dx dy
    showLayout layout
    )

Tekstin leveys ja korkeus saadaan funktiolla layoutGetExtents. Riippuen kummalla akselilla ollaan, tekstisuorakulmion vasen ylänurkka siirretään joko tekstin leveys vasemmalle ja puolet ylös tai puolet vasemmalle ja vähän alas.

Saadaksemme enemmän todellisuutta vastaavan tilanteen, olen kopioinut kirjoitusnopeustestin tietorakenteet ja funktiot, jotka lukevat testin tulokset. Tällä kertaa olemme lähinnä kiinnostuneita varsinaisesta tuloksesta ja tulosten syntyjärjestyksestä.

Lajittelemme tulokset syntyjärjestyksen mukaan luomalla tyypin Result instanssin järjestysominaisuuden sisältävälle tyyppiluokalle Ord. Muuttujat a ja aa sisältävät päivämäärän. Instanssin toteutus on yksinkertainen kahden päivämäärän vertaaminen toisiinsa.

Koodia: [Valitse]

instance Ord Result where
  (Result a b c d) `compare` (Result aa bb cc dd) =
    a `compare` aa

oneResult (Result { rDate = a, rMrks = b, rRank = c, rErrs = d }) =
  speed b

collectResults results =
  zip [1.0..] (map oneResult byDate)
  where
    byDate = sort results

Mitä johtopäätöksiä kuvan perusteella voi tehdä, sitä en tiedä.



Kun kuvan koko on aseteltu sopivaksi, se talletetaan hiiren oikealla painikkeella tiedostoon "tulokset.png". Tämä tapahtuu asettamalla tapahtumankäsittelijä funktioon main.

Koodia: [Valitse]

  on window buttonPressEvent (whenButtonPressed draw1 values upbox)

Funktio whenButtonPressed huolehtii tapahtuman käsittelystä. Kuva talletetaan funktiossa savePNG. Kuvan tallettaminen on periaatteessa aivan sama operaatio kuin kuvan piirtäminen ruudulle, mutta ruudun sijasta kuva piirretään tiedostoon.

Ohjelmakoodi: http://personal.inet.fi/koti/jhii/ruksit-03.hs

[snifi]

Mitta-asteikon arvojen automaattinen pyöristys on tehty tässä seuraavassa. Desimaalilukujen pyöristämiseen funktio printf on ihan hyvä väline, kunhan tietää suurin piirtein montako desimaalia haluaa. Esimerkiksi printf "%.2f" palauttaa luvun esityksen kahdella desimaalilla.

Ohjelma jakautuu kahteen tapaukseen sen mukaan pyöristetäänkö desimaalilukuja vai kokonaislukuja. Tavoitteena oli noin kymmenen prosentin pyöristystarkkuus listan ensimmäisen ja toisen alkion välisen etäisyyden suhteen. Funktio sigDigits pyöristää kokonaisluvut. Merkitsevien lukujen lukumäärä saadaan jotakuinkin funktiolla logBase 10.0. Pienet desimaaliluvut antavat negatiivisen eksponentin, joka tulkitaan sopivaan muotoon. Nolla käsitellään erikseen, sillä 10.0 korotettuna mihinkään potenssiin ei päädy nollaan ja seurauksena olisi virhetilanne.

Koodia: [Valitse]

import Control.Monad (forM_)
import Text.Printf (printf)

main = do
  forM_ tests (\lst -> printList lst)

printList list = do
  putStrLn ("list = " ++ show lst)
  putStr ("result =")
  forM_ lst (\x -> putStr (" " ++ f x))
  putStrLn "\n"
  where
    f x = printf fmtStr (func x)
    (fmtStr,func) = precisionStr lst
    lst = take 4 list

tests = [
  [0.0,1234.56..],
  [410.0,432.2..],
  [0.0,12.3..],
  [0.0,0.3333..],
  [0.0,0.123..],
  [0.0,0.0..]]

precisionStr values
  | place >= 0  = (decimalFmt, sigDigits place)
  | otherwise   = (floatFmt place, id)
  where
    decimalFmt = "%.0f"
    floatFmt d = "%."  ++ (show (abs d)) ++ "f"
    place = round lg
    lg | df == 0.0 = 0.0
       | otherwise = logBase 10.0 df
    df = 0.1 * diff1
    diff1 = abs ((values !! 1) - (values !! 0))

intToDouble :: Int -> Double
intToDouble i = fromRational (toRational i)

sigDigits :: Int -> Double -> Double
sigDigits aExp number =
  (intToDouble (round (number / factor))) * factor
  where
    factor = 10.0 ** (intToDouble aExp)

Tulos testilistoille näyttää tältä:

Koodia: [Valitse]

list = [0.0,1234.56,2469.12,3703.68]
result = 0 1200 2500 3700

list = [410.0,432.2,454.4,476.59999999999997]
result = 410 432 454 477

list = [0.0,12.3,24.6,36.900000000000006]
result = 0 12 25 37

list = [0.0,0.3333,0.6666,0.9999]
result = 0.0 0.3 0.7 1.0

list = [0.0,0.123,0.246,0.369]
result = 0.00 0.12 0.25 0.37

list = [0.0,0.0,0.0,0.0]
result = 0 0 0 0


[snifi]

Kerätään seuraavaksi muutama kirjoitustestin tuloksista laadittu kuva pieneen ikkunaan, joka on tarkoitus myöhemmin liittää osaksi pääohjelmaa.



Vertailtavat suureet on koottuna listaan framelist, joka sisältää tietueina viiden kuvan piirtämiseen tarvittavat selitteet ja funktiot:

Koodia: [Valitse]

framelist = [
  ("X = Järjestysluku\nY = Nopeus (mrk/min)",
    Count, speedResult, earlierFst),
  ("X = Päivämäärä\nY = Nopeus (mrk/min)",
    Calc dateResult, speedResult, earlierFst),
  ("X = Nopeus (mrk/min)\nY = Virheprosentti",
    Calc speedResult, errorProsResult, slowerFst),
  ("X = Sijoitus\nY = Nopeus (mrk/min)",
    Count, speedResult, fasterFst),
  ("X = Päivämäärä\nY = Virheprosentti",
    Calc dateResult, errorProsResult, earlierFst)]

Koska tarvitsemme erilaisia kriteereitä tiedon lajittelemiseen, on varmaankin hyvä luopua ajatuksesta sisällyttää lajittelukriteeri Haskell-kielen tyyppiluokkiin. Laaditaan sen sijaan vertailufunktiot ja lajitellaan tulokset funktiolla sortBy, joka saa vertailufunktion ensimmäisenä parametrinaan.

Lajittelukriteereinä ovat seuraavassa "nopeampi ensin", "hitaampi ensin", "aikaisempi ensin".

Koodia: [Valitse]

fasterFst (Result date1 mrks1 rnk1 errs1) (Result date2 mrks2 rnk2 errs2) =
  if mrks1 /= mrks2
    then mrks2 `compare` mrks1
    else date1 `compare` date2

slowerFst (Result date1 mrks1 rnk1 errs1) (Result date2 mrks2 rnk2 errs2) =
  mrks1 `compare` mrks2

earlierFst (Result date1 mrks1 rnk1 errs1) (Result date2 mrks2 rnk2 errs2) =
  date1 `compare` date2

Nämä funktiot saavat parametreinaan kaksi tietotyypin Result arvoa ja ne poimivat tarvittavat kentät tietotyypistä ja suorittavat vertailun. Tietotyypin Result määrittely on pääohjelman mukainen, jolloin tulostiedot luetaan tyyppiluokan Read avulla.

Koodia: [Valitse]

data Result = Result {
  rDate :: String,
  rMrks, rRank, rErrs :: Int
} deriving (Read, Show)

Vastaavasti virheprosentti ja nopeus saadaan funktioilla errorProsResult ja speedResult.

Koodia: [Valitse]

errorProsResult (Result date1 mrks1 rnk1 errs1) =
  errorPros errs1 mrks1

speedResult (Result date1 mrks1 rnk1 errs1) =
  speed mrks1

Järjestysluku ei sisälly tietotyyppiin Result, joten se tuotetaan funktiolla [1.0..].

Haskell-kieli on voimakkaasti tyypitetty kieli ja tästä johtuen myös listan alkioiden tulee olla samaa tyyppiä. Esimerkiksi lista [5,2,"numerot","vs","merkkijonot"] ei ole sallittu. Ongelma ratkaistaan määrittelemällä tietotyyppi, joka kokoaa yhteen molemmat tapaukset.

Koodia: [Valitse]

data NumberOrString = Numb Int | Str String
list1 = [Numb 5, Numb 2, Str "numerot", Str "vs", Str "merkkijonot"]

Samoin listoissa esiintyvien funktioiden tulee olla samaa tyyppiä. Tämän mukaisesti varustetaan järjestysluvun tuottava funktio konstruktorilla Count ja tietuetta Result käyttävä funktio konstruktorilla Calc, jolloin kuvalista saadaan esitettyä yhtenäisesti ja tarvittavat arvot laskettua funktiossa collectResults. Y-akselilla konstruktoreita ei tarvita, sillä siellä kaikki funktiot ovat samaa tyyppiä.

Koodia: [Valitse]

type RFunction = Result -> Double
data FuncResult = Count | Calc RFunction

collectResults xFunc yFunc sortCrit values =
  zip (xResult xFunc) yResult
  where
    xResult Count = [1.0..]
    xResult (Calc f) = map f sortedByCrit
    yResult = map yFunc sortedByCrit
    sortedByCrit = sortBy sortCrit values

Funktio zip kokoaa tuttuun tapaan kaksi listaa kaksialkioisten tietueiden muodostamaksi listaksi.

Koodia: [Valitse]

> zip [1..] "abcd"
[(1,'a'),(2,'b'),(3,'c'),(4,'d')]

Piirtämisen nopeuttamiseksi aikaisemmat ruksit on korvattu suorakulmioilla.

Koodia: [Valitse]

drawOneMarker cr (r,g,b) = do
  rectangle (-cr) (-cr) cr cr
  setSourceRGBA r g b 0.5
  fill

Kuvat sijoitetaan pystysuuntaiseen laatikkoon upbox funktiolla createFrames. Tämä laatikko asetetaan vieritysikkunaan scrolledWin ja vieritysikkuna edelleen pääikkunan ensisijaiseksi sisältökomponentiksi.

Koodia: [Valitse]

  upbox <- vBoxNew False 0
  createFrames valuess upbox
  scrolledWin <- scrolledWindowNew Nothing Nothing
  scrolledWindowAddWithViewport scrolledWin upbox
  scrolledWindowSetPolicy scrolledWin PolicyAutomatic PolicyAutomatic
  set window [
    containerChild := scrolledWin,
    windowDefaultWidth := 380,
    windowDefaultHeight := 380 ]

Ohjelmakoodi: http://personal.inet.fi/koti/jhii/ruksit-06.hs

[snifi]

Ensi viikolla minulla on edessä operaattorin vaihto, jolloin kuvien ja lähdekoodin linkit tässä ketjussa eivät tule enää toimimaan. Uusi operaattori käyttää WordPressiä, enkä ole vielä opetellut miten esimerkiksi Haskell-lähdekoodit sinne lähetetään.

Olkoon tässä siis ohjelman viimeinen versio tämän ketjun osalta: http://personal.inet.fi/koti/jhii/hatupist-103.hs

Tuloskaaviot löytyvät ikkunasta, joka avautuu valikon kohdasta "Tietoja".

Gtk:n omat piirtorutiinit on korvattu Cairon vastaavilla. Suurin muutos on varmaankin, että Cairon piirtorutiinit käyttävät kokonaislukujen sijasta desimaalilukuja parametreinaan. Esimerkiksi värit määritellään punaisen, vihreän ja sinisen komponentteina, jotka saavat arvot nollan ja ykkösen väliltä, esimerkiksi

Koodia: [Valitse]

blue   = (0.200, 0.400, 1.000)
green  = (0.451, 0.824, 0.086)
red    = (1.000, 0.200, 0.400)
yellow = (0.988, 0.914, 0.310)
black  = (0.000, 0.000, 0.000)
Tyypillinen Cairon piirtoalueen yhdistäminen komponenttiin tapahtuu kuten virheraidoituksen kohdalla seuraavassa:

Koodia: [Valitse]

drawErrorCanvas gsRef widget _evt = do
  gs <- readIORef gsRef
  drawWin <- widgetGetDrawWindow widget
  (wInt,hInt) <- widgetGetSize widget
  let (w,h) = (intToDouble wInt, intToDouble hInt)
  if (oldStatus gs) /= Error
    then drawEmptyPicture widget
    else renderWithDrawable drawWin (drawErrorPicture w h)
  return True
Funktio intToDouble on määritelty aieimmin, esimerkkinä funktiosta joka vaatii tyyppimäärittelyn, sillä muutoin Haskell-kielen automaattinen tyypin päättely ei selviydy tehtävästään.

Koodia: [Valitse]

intToDouble :: Int -> Double
intToDouble i = fromRational (toRational i)
Tällöin piirtorutiini näyttää jotakuinkin tältä:

Koodia: [Valitse]

relPolygon (x,y) points (r,g,b) = do
  moveTo x y
  mapM (\(x,y) -> relLineTo x y) points
  closePath
  setSourceRGB r g b
  fill

drawErrorPicture w h = do
  let c = h
      r = 15
  mapM
    ( \(x,y,points,color) -> relPolygon (x,y) points color)
    [(x,0,[((-c),h),(r,0),(c,(-h))],
     color) | (x,color) <- zip [0,r..w+c] (cycle [blue,red])]
  return True

[snifi]

Päivitetty versio kuvineen ja linkkeineen löytyy nyt GitHubista: https://github.com/jsavatgy/hatupist
Aivan kaikki kappaleet eivät vielä ole mukana, korjailen niitä sitä mukaa kuin ennätän.