Ubuntu Suomen keskustelualueet
Ubuntun käyttö => Ohjelmointi, palvelimet ja muu edistyneempi käyttö => Aiheen aloitti: snifi - 29.05.13 - klo:21.52
-
Aloitan tämän viestiketjun tavoitteena tulevien kuukausien aikana yhdessä rakentaa ohjelma, jolla harjoitella kirjoitusnopeutta kymmensormijärjestelmällä (tai miksei muullakin -järjestelmällä). Olen ajatellut, että ohjelman ulkoasu voisi näyttää vaikkapa jotakuinkin tämänlaiselta:
(http://personal.inet.fi/koti/jhii/Hatupist_007.png)
Itse tulen käyttämään Haskell-ohjelmointikieltä ja Gtk2hs-käyttöliittymää.
Ensimmäinen tehtävä olisi laatia tekstitiedosto, joka sisältää harjoiteltavaksi tarkoitetun tekstin. Mitä pitempi, ja mitä monipuolisempaa kieliasultaan, sen parempi. Ohjelman tehtävä on ensi alkuun lukea kyseinen tekstitiedosto, rivittää se uudelleen ja poistaa kirjoituskelvottomat merkit (kuten rivinvaihdot, tms) tekstistä. Tähän tarvittavien rutiinien kokeilu olisi seuraavan jakson aiheena, eli tekstin lukeminen, manipulointi ja tulostaminen ruudulle.
-
Tekstitiedoston manipulointiin voisi käyttää vaikkapa seuraavanlaista koodia:
lineLen = 35
main = do
originalText <- readFile ("hatupist.txt")
print originalText
let liness = colLines (collectWords (words (originalText)) lineLen)
let lines = map (++" ") liness
mapM_ putStrLn (lines)
colLines (xs:xss) =
(unwords xs) : colLines xss
colLines [] = []
collectWords [] n = []
collectWords ys n =
p1 : collectWords p2 n
where
(p1,p2) = splitAt (length (untilLen ys 0 n)) ys
untilLen (t:ts) s n
| s+x<n || s==0 = t : untilLen ts (s+x) n
| otherwise = []
where
x = length t + 1
untilLen [] s n = []
Kirjoitetaan tekstitiedostoon hatupist.txt kokeilumielessä seuraava teksti:
Morse-aakkoset.
Graafinen muistisääntö.
Piirretään suuri A-kirjain. Väritetään kirjaimen huippupiste ja
vaakaviiva. A-kirjain on siten ti-taa.
Seuraavaksi piirretään I-kirjain. Väritetään kirjaimen molemmat päät.
I-kirjain on ti-ti.
E-kirjain on keskimmäisen poikkiviivan leikkauspiste pystyviivan kanssa.
E-kirjain on ti.
O-kirjaimessa on pitkästi ympyrän kehää väritettäväksi. Täytetään kehä
kolmella viivalla. O-kirjain on taa-taa-taa.
U-kirjaimesta väritetään molemmat huippupisteet ja pohjakaari. U-kirjain
on ti-ti-taa.
Edellinen ohjelmakoodi tulostaa nyt:
$ runhaskell luetiedosto.hs
"Morse-aakkoset.\n\nGraafinen muistis\228\228nt\246.\n\nPiirret\228\228n su
uri A-kirjain. V\228ritet\228\228n kirjaimen huippupiste ja vaakaviiva. A-k
irjain on siten ti-taa.\n\nSeuraavaksi piirret\228\228n I-kirjain. V\228rit
et\228\228n kirjaimen molemmat p\228\228t. I-kirjain on ti-ti.\n\nE-kirjain
on keskimm\228isen poikkiviivan leikkauspiste pystyviivan kanssa. E-kirjai
n on ti.\n\nO-kirjaimessa on pitk\228sti ympyr\228n keh\228\228 v\228ritett
\228v\228ksi. T\228ytet\228\228n keh\228 kolmella viivalla. O-kirjain on ta
a-taa-taa.\n\nU-kirjaimesta v\228ritet\228\228n molemmat huippupisteet ja p
ohjakaari. U-kirjain on ti-ti-taa.\n\n"
Morse-aakkoset. Graafinen
muistisääntö. Piirretään suuri
A-kirjain. Väritetään kirjaimen
huippupiste ja vaakaviiva.
A-kirjain on siten ti-taa.
Seuraavaksi piirretään I-kirjain.
Väritetään kirjaimen molemmat
päät. I-kirjain on ti-ti.
E-kirjain on keskimmäisen
poikkiviivan leikkauspiste
pystyviivan kanssa. E-kirjain on
ti. O-kirjaimessa on pitkästi
ympyrän kehää väritettäväksi.
Täytetään kehä kolmella viivalla.
O-kirjain on taa-taa-taa.
U-kirjaimesta väritetään molemmat
huippupisteet ja pohjakaari.
U-kirjain on ti-ti-taa.
Tekstin manipulointiin tarvittavat rutiinit riippuvat hieman tekstitiedoston muodosta, ja periaatteessa tämän vaiheen voisi jopa sivuuttaa muokkaamalla tekstitiedosto valmiiksi tekstieditorilla. Haskell-kielen Prelude-kirjastosta käytettäviä funktioita olivat words ja unwords, joiden toimintaperiaate seuraavassa:
$ ghci
Prelude> let ws = words "U-kirjaimesta väritetään molemmat huippupisteet ja pohjakaari."
Prelude> ws
["U-kirjaimesta","v\228ritet\228\228n","molemmat","huippupisteet","ja","pohjakaari."]
Prelude> unwords ws
"U-kirjaimesta v\228ritet\228\228n molemmat huippupisteet ja pohjakaari."
Prelude> :q
Leaving GHCi.
Seuraavalla kerralla sijoittelemme komponentteja graafiseen ikkunaan. Käytettävät komponentit ovat edellisestä kuvasta 3xListStore, 2xImage, 2xLabel, TextBuffer, Statusbar. Lisäksi tarvitaan asemointia varten erinäinen määrä vboxeja, hboxeja ja separaattoreita.
-
Muutama tarvittava komponentti jotakuinkin oletusasetuksilla:
import Graphics.UI.Gtk
xxx = "xxxx xx xxx xxxxx xx xxxxxxx xxx xxxxxxxxxx xx."
main = do
initGUI
window <- windowNew
onDestroy window mainQuit
vbox <- vBoxNew False 0
set window [
containerBorderWidth := 10,
windowTitle := "Hatupist",
containerChild := vbox ]
sep1 <- hSeparatorNew
boxPackStart vbox sep1 PackNatural 3
label1 <- labelNew (Just xxx)
miscSetAlignment label1 0 0
boxPackStart vbox label1 PackNatural 0
label2 <- labelNew (Just xxx)
miscSetAlignment label2 0 0
boxPackStart vbox label2 PackNatural 0
sep2 <- hSeparatorNew
boxPackStart vbox sep2 PackNatural 3
textview <- textViewNew
boxPackStart vbox textview PackNatural 3
statusbar <- statusbarNew
set statusbar [ statusbarHasResizeGrip := False ]
boxPackStart vbox statusbar PackNatural 5
widgetShowAll window
mainGUI
Tämä tuottaa seuraavanlaisen ikkunan:
(http://personal.inet.fi/koti/jhii/Hatupist_008.png)
Seuraavalla kerralla voisimme kokeilla tekstikentän puskurille tehtävää tapahtumankäsittelijää, jonka avulla päättelemme mitä käyttäjä on kirjoittanut ja minkä verran siitä on mennyt oikein, ja ehkä ajastimen toimintaa myös.
-
Asetaan tekstikentälle textview tekstipuskuri buffer. Tekstipuskuri lähettää signaalin onBufferChanged aina kun puskurin sisältö muuttuu.
Käyttötarpeisiimme sopivan kellonajan saamme järjestelmän POSIX-aikana. Tarvittava funktio getPOSIXTime löytyy kirjastosta Data.Time.Clock.POSIX.
Tämän lisäksi luodaan ajastin komennolla timeoutAdd. Ajastimen lähettämä signaali käsitellään funktiossa timeIsOut, ja se lähetetään 1000 millisekunnin eli noin sekunnin välein (järjestelmän kiireistä riippuen). Funktion palauttama arvo True kertoo, että ajastin jatkaa toimintaansa tapahtumankäsittelyn jälkeen.
import Graphics.UI.Gtk
import Data.Time.Clock.POSIX
xxx = "xxxx xx xxx xxxxx xx xxxxxxx xxx xxxxxxxxxx xx"
main = do
initGUI
window <- windowNew
onDestroy window mainQuit
vbox <- vBoxNew False 0
set window [
containerBorderWidth := 10,
windowTitle := "Hatupist",
containerChild := vbox ]
label1 <- labelNew (Just xxx)
miscSetAlignment label1 0 0
boxPackStart vbox label1 PackNatural 0
textview <- textViewNew
boxPackStart vbox textview PackNatural 3
buffer <- textViewGetBuffer textview
onBufferChanged buffer (bufferHasChanged buffer)
timeoutAdd timeIsOut 1000
widgetShowAll window
mainGUI
bufferHasChanged buffer = do
txt <- get buffer textBufferText
pt <- getPOSIXTime
putStrLn ("Puskuri ## " ++ (show pt) ++ ": " ++ txt)
return ()
timeIsOut = do
pt <- getPOSIXTime
putStrLn ("Ajastin ## " ++ show pt)
return True
Ohjelma tulostaa tapahtumat päätteelle:
$ runhaskell simple-events.hs
Ajastin ## 1371671421.264802s
Ajastin ## 1371671422.266191s
Puskuri ## 1371671422.751292s: K
Ajastin ## 1371671423.266732s
Puskuri ## 1371671423.342312s: Ka
Puskuri ## 1371671423.86113s: Kau
Puskuri ## 1371671424.09616s: Kauk
Puskuri ## 1371671424.192814s: Kauka
Ajastin ## 1371671424.267482s
Puskuri ## 1371671424.380527s: Kaukan
Puskuri ## 1371671424.445665s: Kaukana
Ajastin ## 1371671425.269007s
Ajastin ## 1371671426.269852s
Seuraavalla kerralla yritämme sommitella taulukkokomponentteja tulostietojen näyttämiseen. Tarvittava komponentti (eli näkymä) on nimeltään treeView ja sen käyttämä malli ListStore.
-
Tässä on nopeasti kokoon kyhätty koodi tulostaulun näyttämiseen. Koodissa on monta kohtaa, jotka voisi vielä korvata lyhyemmällä silmukalla. En nyt vain tällä hetkellä vielä osaa oikein hyvin silmukoiden käyttöä monadin sisällä.
import Graphics.UI.Gtk
import Text.Printf
data Result = Result {
date :: String, mrk :: Double,
rank :: Int, errorPros :: Double
} deriving (Read, Show)
type Results = [Result]
zeroResult = Result {
date = "0000-00-00 00:00:00",
mrk = 0.0, rank = 0, errorPros = 0.0 }
main = do
initGUI
window <- windowNew
onDestroy window mainQuit
-- treeview1
model <- listStoreNew (replicate 3 zeroResult)
view <- treeViewNewWithModel model
set view [ widgetCanFocus := False ]
col1 <- treeViewColumnNew
col2 <- treeViewColumnNew
col3 <- treeViewColumnNew
col4 <- treeViewColumnNew
treeViewColumnSetTitle col1 "Päiväys"
treeViewColumnSetTitle col2 "Tulos"
treeViewColumnSetTitle col3 "Sija"
treeViewColumnSetTitle col4 "Virheitä"
renderer1 <- cellRendererTextNew
renderer2 <- cellRendererTextNew
renderer3 <- cellRendererTextNew
renderer4 <- cellRendererTextNew
cellLayoutPackStart col1 renderer1 True
cellLayoutPackStart col2 renderer2 True
cellLayoutPackStart col3 renderer3 True
cellLayoutPackStart col4 renderer4 True
cellLayoutSetAttributes col1 renderer1 model (
\row -> [ cellText := date row ])
cellLayoutSetAttributes col2 renderer2 model (
\row -> [ cellText := f01 (mrk row) ])
cellLayoutSetAttributes col3 renderer3 model (
\row -> [ cellText := showRank (rank row) ])
cellLayoutSetAttributes col4 renderer4 model (
\row -> [ cellText := f01 (errorPros row) ])
treeViewAppendColumn view col1
treeViewAppendColumn view col2
treeViewAppendColumn view col3
treeViewAppendColumn view col4
vbox <- vBoxNew False 0
boxPackStart vbox view PackNatural 3
set window [
containerBorderWidth := 10,
windowTitle := "Hatupist",
containerChild := vbox ]
widgetShowAll window
mainGUI
maxRank = 5000
showRank rank
| rank <= maxRank = show rank
| otherwise = ">" ++ show maxRank
f01 :: Double -> String
f01 = printf "%.1f"
Kirjastosta Text.Printf löytyy liukuluvun muotoiluun sopiva funktio printf. Se on kuormitettu funktio, joka tyyppiluokan Show instanssina palauttaa muotoillun merkkijonon, eikä siis nimestään huolimatta tulosta sitä, kuten se tyyppiluokan IO instanssina tekisi. Funktio f01 käyttää tätä funktiota. Liukuluvun muotoilumerkkijono annetaan samassa muodossa kuin muilla yleisillä ohjelmointikielillä.
Ohjelman tulostama ikkuna näyttää tällaiselta:
(http://personal.inet.fi/koti/jhii/Hatupist_009.png)
-
Silmukan rakentaminen onnistuu palauttamalla mieliin funktiot map ja zip, sekä määrittelemällä yksinkertainen nimetön lambda-funktio:
$ ghci
Prelude> map (4*) [1,3,5,7]
[4,12,20,28]
Prelude> let z = zip ['a','b','c'] [1,3,7]
Prelude> z
[('a',1),('b',3),('c',7)]
Prelude> map (\(h,j) -> (show j ++ [h])) z
["1a","3b","7c"]
Prelude>
Monadin sisällä funktio map tulee muotoon mapM. Näin ollen tulostaulu-ohjelma näyttää kokonaisuudessaan tältä:
import Graphics.UI.Gtk
import Text.Printf
data Result = Result {
date :: String, mrk :: Double,
rank :: Int, errors :: Double
} deriving (Read, Show)
zeroResult = Result {
date = "0000-00-00 00:00:00",
mrk = 0.0, rank = 0, errors = 0.0 }
main = do
initGUI
window <- windowNew
onDestroy window mainQuit
-- treeview1
model1 <- listStoreNew (replicate 3 zeroResult)
view1 <- treeViewNewWithModel model1
setupView view1 model1
vbox <- vBoxNew False 0
boxPackStart vbox view1 PackNatural 3
set window [ windowTitle := "Hatupist", containerChild := vbox ]
widgetShowAll window
mainGUI
colTitle = ["Päiväys", "Tulos", "Sija", "Virheitä" ]
colFunc = [ date, f01 . mrk, show . rank, f02p . errors]
setupView view model = do
mapM
( \(title, func) -> newcol view model title func )
( zip colTitle colFunc )
where
newcol view model title func = do
renderer <- cellRendererTextNew
col <- treeViewColumnNew
cellLayoutPackStart col renderer True
cellLayoutSetAttributes col renderer model (
\row -> [ cellText := func row])
treeViewColumnSetTitle col title
treeViewAppendColumn view col
f01 :: Double -> String
f01 = printf "%.1f"
f02p :: Double -> String
f02p = printf "%.2f%%"
Jatkossa muutokset tauluun tehdään mallin model1 kautta. Ja koska tulostauluja on kolme erilaista, voimme ehkä vielä tehdä toisen silmukan niiden näyttämiseksi.
-
Tuossa minun prototyypissäni ei ole laisinkaan valikkoa, mutta ajattelin, että tähän viralliseen versioon laitettaisiin sellainen. Nykyisin on tapana yhdistää toiminteet ja valikot yhdeksi kokonaisuudeksi, joten pelkän valikon rakentamiseen soveltuvaa koodia oli vaikea löytää. Tässä nyt kuitenkin jonkinlainen esimerkki, jota voidaan myöhemmin täydentää:
module Main (main) where
import Graphics.UI.Gtk
createMenuBar descr = do
bar <- menuBarNew
mapM_ (createMenu bar) descr
return bar
where
createMenu bar (name,items) = do
menu <- menuNew
item <- menuItemNewWithLabelOrMnemonic name
menuItemSetSubmenu item menu
menuShellAppend bar item
mapM_ (createMenuItem menu) items
createMenuItem menu (stock,action) = do
item <- imageMenuItemNewFromStock stock
menuShellAppend menu item
onActivateLeaf item action
menuItemNewWithLabelOrMnemonic name
| elem '_' name = menuItemNewWithMnemonic name
| otherwise = menuItemNewWithLabel name
noop = do
return ()
menuBarDescr =
[("_Tiedosto",
[("gtk-open", noop),
("gtk-select-font", noop),
("gtk-preferences", noop),
("gtk-about", noop),
("gtk-quit", mainQuit)])
]
main = do
initGUI
window <- windowNew
menuBar <- createMenuBar menuBarDescr
set window [ windowTitle := "Manual Menubar Demo",
containerChild := menuBar ]
onDestroy window mainQuit
widgetShowAll window
mainGUI
Seuraavaksi teemme rutiinin, joka vaihtaa uuden tekstirivin aina sitä mukaa kuin käyttäjä saa edellisen valmiiksi.
-
Haskell-kielessä ei ole globaaleja muuttujia, joten niitä korvaamaan käytetään esimerkiksi IORef-kirjaston rutiineja. Viite muuttujiin luodaan komennolla newIORef, muuttujat luetaan komennolla readIORef ja kirjoitetaan komennolla writeIORef. Seuraavassa globaalit muuttujat on pyritty keräämään tietorakenteeseen State, jota myöhemmin täydennetään, ja muuttuja gs on viittaus tähän globaalien muuttujien kokoelmaan.
Ohjelman asetukset ovat tietorakenteessa Settings, ja niihin viitataan muuttujien settings ja defaultSettings avulla. Kukin globaali muuttuja ja asetusten muuttuja tulee näin ollen funktioksi, jonka ensimmäinen parametri on kokoelma, johon ne on sisällytetty, esimerkiksi startLine settings tai currentLine gs.
Samaan tapaan kaikki tarvittavat viittaukset graafisiin komponentteihin on kerättynä tietorakenteeseen GUI, johon viitataan muuttujalla gui. Tästä saavutettava hyöty on, että funktioiden parametrien määrä pysyy kohtuullisena.
Olen käyttänyt tässä jo apumuuttujaa oLabelStrs tietoisena siitä, että tulemme myöhemmin napsimaan kirjaimia pois varsinaisen komponentin tekstistä.
import Graphics.UI.Gtk
import Data.IORef
import Control.Monad (when)
data GUI = GUI {
gBuffer :: TextBuffer,
gLabel1, gLabel2 :: Label
}
data State = State {
oLabelStrs :: [String],
currentLine :: Int
}
initState = State {
oLabelStrs = ["",""],
currentLine = 0
}
data Settings = Settings {
lineLen :: Int, startLine :: Int,
textfile :: String
} deriving (Read, Show)
defaultSettings = Settings {
lineLen = 40, startLine = 0,
textfile = "hatupist.txt"
}
settings = defaultSettings
xxx = replicate (lineLen defaultSettings) 'x'
main = do
gs <- newIORef initState {
currentLine = startLine settings
}
initGUI
originalText <- readFile (textfile settings)
let liness = colLines (collectWords (words (originalText)) (lineLen settings))
lines = map (++" ") liness
gui <- createGUI
renewLabels gui (startLine settings) lines gs
onBufferChanged (gBuffer gui) (
whenBufferChanged gui settings lines gs)
mainGUI
createGUI = do
window <- windowNew
onDestroy window mainQuit
vbox <- vBoxNew False 0
set window [
containerBorderWidth := 10,
windowTitle := "Hatupist",
containerChild := vbox ]
label1 <- labelNew (Just xxx)
miscSetAlignment label1 0 0
boxPackStart vbox label1 PackNatural 0
label2 <- labelNew (Just xxx)
miscSetAlignment label2 0 0
boxPackStart vbox label2 PackNatural 0
textview <- textViewNew
boxPackStart vbox textview PackNatural 3
buffer <- textViewGetBuffer textview
widgetShowAll window
return GUI {
gBuffer = buffer,
gLabel1 = label1,
gLabel2 = label2
}
renewLabels gui currentLine lines gsRef = do
gs <- readIORef gsRef
let labelStrs = labelStrings currentLine lines
set (gLabel1 gui) [ labelLabel := labelStrs !! 0 ]
set (gLabel2 gui) [ labelLabel := labelStrs !! 1 ]
writeIORef gsRef gs {
oLabelStrs = labelStrs
}
set (gBuffer gui) [ textBufferText := "" ]
labelStrings :: Int -> [String] -> [String]
labelStrings startline lines =
[lines !! first] ++ [lines !! second]
where
first = startline `mod` (length lines)
second = (startline + 1) `mod` (length lines)
whenBufferChanged gui settings lines gsRef = do
gs <- readIORef gsRef
txt <- get (gBuffer gui) textBufferText
let label1Str = head (oLabelStrs gs)
when (label1Str == txt) (advanceLine gui lines gsRef gs)
return ()
advanceLine gui lines gsRef gs = do
writeIORef gsRef gs {
currentLine = ncline
}
renewLabels gui ncline lines gsRef
return ()
where
ncline = ((currentLine gs) + 1) `mod` (length lines)
colLines (xs:xss) =
(unwords xs) : colLines xss
colLines [] = []
collectWords [] n = []
collectWords ys n =
p1 : collectWords p2 n
where
(p1,p2) = splitAt (length (untilLen ys 0 n)) ys
untilLen (t:ts) s n
| s+x<n || s==0 = t : untilLen ts (s+x) n
| otherwise = []
where
x = length t + 1
untilLen [] s n = []
Ohjelman avaama ikkuna näyttää tässä vaiheessa seuraavanlaiselta. Se lukee tekstitiedoston aikaisemmin esiteltyjä funktioita käyttäen, ja vaihtaa uuden tekstirivin edellisen tullessa valmiiksi.
(http://personal.inet.fi/koti/jhii/Hatupist_010.png)
-
Tänään ajattelin hahmotella millaisessa tilassa ohjelma milloinkin on. Vaihtoehdot luetellaan tietorakenteessa GameStatus:
data GameStatus = OldError | NewError | Correct | Back | NotStarted
deriving (Eq, Show)
Tilatieto on takaisinkutsufunktioiden vaatima globaali muuttuja, joten se kuuluu tietorakenteeseen State, siellä olevien aikaisempien muuttujien joukkoon:
data State = State {
status :: GameStatus,
olabelStrs :: [String],
currentLine :: Int
}
Tila voi saada yhden seuraavista arvoista:
NotStarted: Ohjelman käynnistyessä, kun yhtään merkkiä ei ole syötetty. Tilarivillä näytetään teksti "Voit aloittaa". Tulostaulut näyttävät nollaa, eikä ajastinta ole käynnistetty.
Correct: Käyttäjä on kirjoittanut tekstiä, ja teksti on oikein. Näppäimistönpainallukset rekisteröidään.
NewError: Käyttäjä on lyönyt virhelyönnin. Virhe rekisteröidään ja käyttäjää pyydetään korjaamaan virheet. Ohjelma siirtyy tilaan OldError.
OldError: Ohjelma on tässä tilassa siihen saakka kunnes teksti on jälleen oikein, jolloin siirrytään takaisin tilaan Correct. Uusia virheitä ei rekisteröidä, jolloin yksi lyöntivirhe vastaa yhtä virhettä tilastossa ja käyttäjä voi korjata tekstin.
Back: Teksti on oikein, mutta käyttäjä (jostain syystä) poistaa merkkejä. Näppäimistönpainalluksista ei tällöin synny rekisteröitävää tietoa.
Tila saadaan seuraavan algoritmin avulla:
getStatus :: String -> String -> Int -> GameStatus
getStatus written goal tlen
| a == b && c < d = Correct
| a == b = Back
| otherwise = NewError
where
a = written
b = commonPrefix written goal
c = tlen
d = length written
Tässä parametri written on merkkijono, joka kertoo mitä käyttäjä on kirjoittanut tekstikenttään. Parametri goal on merkkijono, joka kertoo tavoitteen, mitä olisi pitänyt kirjoittaa, eli käytännössä se on tekstirivi komponentista Label1, tai tarkemmin ottaen oLabelStr1, jota käsiteltiin viime kerralla. Parametri tlen on aikaisemman näppäimistönpainalluksen yhteydessä talteen otettu kirjoitetun tekstin pituus. Tämän perusteella voidaan päätellä lisäsikö käyttäjä tekstiä vai poistiko sitä.
Funktio commonPrefix palauttaa merkkijonon, joka kuvastaa minkä verran kahden parametrina annetun merkkijonon alussa on samaa tekstiä. Se on määritelty seuraavasti:
commonPrefix (x:xs) (y:ys)
| x == y = x : commonPrefix xs ys
commonPrefix _ _ = []
Lopuksi vielä virheen sattuessa selvitetään oliko kysymyksessä uusi vai vanha virhe. Aikaisemman tilan ollessa Correct tai NotStarted, on kysymyksessä uusi virhe. Muutoin on kysymyksessä vanha virhe:
oldNewError Correct = NewError
oldNewError NotStarted = NewError
oldNewError _ = OldError
-
Nyt kun ajattelen tarkemmin, niin ehkä selviäisimme paremmin yksinkertaisemmalla määrittelyllä:
data GameStatus = Error | Correct | Back | NotStarted
deriving (Eq, Show)
Tällöin tarkasteltaviksi tapauksiksi tulisivat (status,oldStatus)-parit, ja puskurin muutoksiin vastaava koodi näyttäisi nyt alkuvaiheessa seuraavalta:
whenBufferChanged gui settings lines gsRef = do
gs <- readIORef gsRef
txt <- get (gBuffer gui) textBufferText
let label1Str = head (oLabelStrs gs)
status = getStatus txt label1Str (oldlen gs)
f = case (status,oldStatus gs) of
(_,NotStarted) -> whenNotStarted status
(Correct,_) -> whenCorrect
(Error,Correct) -> whenNewError
otherwise -> whenOther status (oldStatus gs)
print (status,oldStatus gs, txt)
f gui settings lines gsRef gs
writeIORef gsRef gs {
oldStatus = status,
oldlen = max (length (commonPrefix txt label1Str)) (oldlen gs)
}
when (label1Str == txt) (advanceLine gui lines gsRef gs)
return ()
whenNotStarted status gui settings lines gsRef gs = do
putStrLn ("Started with " ++ (show status))
return ()
whenCorrect gui settings lines gsRef gs = do
print "Correct."
return ()
whenNewError gui settings lines gsRef gs = do
print "New Error."
return ()
whenOther status oldStatus gui settings lines gsRef gs = do
putStrLn ("Other with " ++ (show (status,oldStatus)))
return ()
Tyypillinen tuloste kokeiltaessa edellistä näyttää tältä:
(Correct,NotStarted,"M")
Started with Correct
(Correct,Correct,"Mo")
"Correct."
(Error,Correct,"Mou")
"New Error."
(Back,Error,"Mo")
Other with (Back,Error)
(Correct,Back,"Mor")
"Correct."
(Back,Correct,"Mo")
Other with (Back,Correct)
Tietorakenteeseen State täytyy luonnollisesti lisätä kenttä oldlen:
data State = State {
oldStatus :: GameStatus,
oldlen :: Int,
oLabelStrs :: [String],
currentLine :: Int
}
initState = State {
oldStatus = NotStarted,
oLabelStrs = ["",""],
oldlen = 0,
currentLine = 0
}
Ja funktiossa advanceLine saavutukset nollataan rivinvaihdon vuoksi:
advanceLine gui lines gsRef gs = do
writeIORef gsRef gs {
currentLine = ncline,
oldlen = 0
}
renewLabels gui ncline lines gsRef
return ()
where
ncline = ((currentLine gs) + 1) `mod` (length lines)
Seuraavaksi tarvitsemme loput tulostaulukomponentit, ja alamme kokeilemaan ajanottoa.
-
Ohjelman ajatus on, että kirjoitusnopeuden mittaus jaetaan puolen minuutin intervalleihin (jatkossa i-etuliite nimissä). Varsinainen tulos on neljän peräkkäisen intervallin merkkimäärien summa, eli kahden minuutin jakso. Tuloksia ylläpitävä tietorakenne on nimeltään Result (r-etuliite nimissä). Istunnolla (Session, s-etuliite) puolestaan tarkoitetaan ajanjaksoa ensimmäisen merkin syöttämisestä ikkunan sulkemiseen, tietorakenne Timing.
iDuration = 30
rDuration = 120
amountOfIntervals = rDuration `div` iDuration
data Result = Result {
rDate :: String,
rMrks, rRank, rErrs :: Int
} deriving (Read, Show)
zeroResult = Result {
rDate = "0000-00-00 00:00:00",
rMrks = 0, rRank = 0, rErrs = 0 }
data Timing = Timing {
sSession :: String, sTotal :: Int,
sSecsLeft :: Int, sSpeed :: Double
} deriving Show
zeroTiming = Timing {
sSession = "00:00", sTotal = 0,
sSecsLeft = iDuration, sSpeed = 0.0 }
data Interval = Interval {
iNum, iMrks, iErrs :: Int
} deriving Show
zeroInterval = Interval {
iNum = -1, iMrks = 0, iErrs = 0 }
Näitä kolmea tietorakennetta kohden on oma tulostaulunsa ohjelman ikkunassa. Tulostauluun luotava alustava malli, sarakkeiden otsikot ja tätä vastaava funktio solun sisällön tulostamiseksi on määritelty seuraavassa:
rInitModel = replicate 3 zeroResult
rColTitles = ["Päiväys", "Tulos", "Sija", "Virheitä" ]
rColFuncs = [ rDate, rSpeed . rMrks, show . rRank, rErrorPros]
sInitModel = [zeroTiming]
sColTitles = ["Istunto", "Yhteensä", "Jakso", "Jaksonopeus"]
sColFuncs = [ sSession, show . sTotal, show . sSecsLeft, f01 . sSpeed]
iInitModel = replicate amountOfIntervals zeroInterval
iColTitles = ["Alkoi", "Päättyi", "Nopeus", "Virheitä" ]
iColFuncs = [ iStarts . iNum, iEnds . iNum, iSpeed . iMrks, iErrorPros]
Käyttöliittymä luodaan tuttuun tapaan funktiossa createGUI:
createGUI = do
window <- windowNew
onDestroy window mainQuit
outerVBox <- vBoxNew False 0
middleHBox <- hBoxNew False 0
innerVBox1 <- vBoxNew False 0
innerVBox2 <- vBoxNew False 0
rModel <- setupView rInitModel rColTitles rColFuncs innerVBox1
sModel <- setupView sInitModel sColTitles sColFuncs innerVBox1
iModel <- setupView iInitModel iColTitles iColFuncs innerVBox2
boxPackStart middleHBox innerVBox1 PackNatural 0
boxPackStart middleHBox innerVBox2 PackNatural 6
boxPackStart outerVBox middleHBox PackNatural 10
set window [
containerBorderWidth := 10,
windowTitle := "Hatupist",
containerChild := outerVBox ]
label1 <- labelNew (Just xxx)
miscSetAlignment label1 0 0
boxPackStart outerVBox label1 PackNatural 0
label2 <- labelNew (Just xxx)
miscSetAlignment label2 0 0
boxPackStart outerVBox label2 PackNatural 0
textview <- textViewNew
boxPackStart outerVBox textview PackNatural 3
buffer <- textViewGetBuffer textview
widgetShowAll window
return GUI {
gBuffer = buffer,
gLabel1 = label1,
gLabel2 = label2
}
Tulostaulujen näkymä luodaan funktiolla setupView, joka tässä vaiheessa näyttää seuraavalta:
setupView initModel titles funcs parent = do
model <- listStoreNew (initModel)
view <- treeViewNewWithModel model
mapM
( \(title, func) -> newcol view model title func )
( zip titles funcs )
set view [ widgetCanFocus := False ]
boxPackStart parent view PackNatural 3
return model
where
newcol view model title func = do
renderer <- cellRendererTextNew
col <- treeViewColumnNew
cellLayoutPackStart col renderer True
cellLayoutSetAttributes col renderer model (
\row -> [ cellText := func row])
treeViewColumnSetTitle col title
treeViewAppendColumn view col
Solutekstien muotoilemiseen on erinäinen määrä apufunktioita, joiden toimintalogiikkaan ei tässä vaiheessa kannattane kiinnittää suurempaa huomiota:
rErrorPros rR =
f02p (errorPros (rErrs rR) (rMrks rR))
iErrorPros iV =
f02p (errorPros (iErrs iV) (iMrks iV))
errorPros errs mrks
| errs == 0 && mrks == 0 = 0.0
| errs /= 0 && mrks == 0 = 100.0
| otherwise = 100.0 * (intToDouble errs) / (intToDouble mrks)
f01 :: Double -> String
f01 = printf "%.1f"
f02p :: Double -> String
f02p = printf "%.2f%%"
iSpeed mrks =
f01 ((intToDouble mrks)* 60.0 / intToDouble iDuration)
rSpeed mrks =
f01 ((intToDouble mrks)* 60.0 / intToDouble rDuration)
iStarts n
| n <= 0 = "00:00"
| otherwise = mmss (fromIntegral (n*iDuration) :: Double)
iEnds n = iStarts (n+1)
mmss seconds =
leadingZero (show (floor seconds `div` 60)) ++
":" ++
leadingZero (show (floor seconds `mod` 60))
leadingZero s
| length s < 2 = "0" ++ s
| otherwise = s
intToDouble :: Int -> Double
intToDouble i = fromRational (toRational i)
Ohjelman tuottama ikkuna näyttää nyt tältä:
(http://personal.inet.fi/koti/jhii/Hatupist_011.png)
-
Intervallit eli kolmenkymmenen sekunnin jaksot on siis määritelty tietorakenteessa Interval, ja alustamaton oletusintervalli on nimeltään zeroInterval, sen tuntee numerosta -1. Lyöntimäärät ja virheet lasketaan kenttiin iMrks ja iErrs.
data Interval = Interval {
iNum, iMrks, iErrs :: Int
} deriving Show
zeroInterval = Interval {
iNum = -1, iMrks = 0, iErrs = 0 }
Tietorakenteeseen State lisätään aloitusaikaa kuvaava kenttä startTime, joka alustetaan epämääräiseen nolla-aikaan vuoteen 1970.
data State = State {
status :: GameStatus,
startTime :: POSIXTime,
...
initState = State {
startTime = fromIntegral 0 :: POSIXTime,
oldStatus = NotStarted,
...
Kun lyönnin aika t sekunteina tunnetaan, saadaan intervallin numero, johon lyönti kuuluu, yksinkertaisella funktiolla:
intervalNumber t =
floor t `div` iDuration
POSIXtime-tyyppi (ja jatkossa lyhenne pt) on kellonaika alkaen vuodesta 1970 sekunteina, joten se käy sekuntimäärien vertailemiseen yksinkertaisella tyyppimuunnoksella:
secondsFrom startPt endPt =
a - b
where
a = ptToDouble endPt
b = ptToDouble startPt
ptToDouble :: POSIXTime -> Double
ptToDouble t = fromRational (toRational t)
intToDouble :: Int -> Double
intToDouble i = fromRational (toRational i)
Tässä funktiot from/toRational ovat jälleen esimerkkejä tyyppiluokkien mukaan kuormitetuista funktioista, eli ne tekevät muunnoksen annettujen tyyppimäärittelyjen mukaisesti.
Puskurin muutoksiin vastaava koodi on nyt seuraavassa muodossa:
whenBufferChanged gui settings lines gsRef = do
pt <- getPOSIXTime
gs <- readIORef gsRef
txt <- get (gBuffer gui) textBufferText
let label1Str = head (oLabelStrs gs)
status = getStatus txt label1Str (oldlen gs)
f = case (status,oldStatus gs) of
(_,NotStarted) -> whenNotStarted status
(Correct,_) -> whenCorrect
(Error,Correct) -> whenNewError
otherwise -> whenOther status (oldStatus gs)
newgs <- f gui settings lines pt gs
writeIORef gsRef newgs {
oldStatus = status,
oldlen = max (length (commonPrefix txt label1Str)) (oldlen gs)
}
when (label1Str == txt) (advanceLine gui lines gsRef gs)
return ()
whenNotStarted status gui settings lines pt gs = do
putStrLn ("Started with " ++ (show status))
return gs {
startTime = pt
}
whenCorrect gui settings lines pt gs = do
print "Correct."
let s = secondsFrom (startTime gs) pt
i = intervalNumber s
print (s,i)
return gs
whenNewError gui settings lines pt gs = do
print "New Error."
return gs
whenOther status oldStatus gui settings lines pt gs = do
putStrLn ("Other with " ++ (show (status,oldStatus)))
return gs
Ja yrittäessäni naksutella noin yhden merkin viidessä sekunnissa, saatiin seuraava tuloste, josta näkyy kulunut sekuntimäärä ja intervalli, johon näppäimistönpainallus kuuluu:
$ runhaskell ajanottoa-01.hs
Started with Correct
"Correct."
(3.952288866043091,0)
"Correct."
(9.909076929092407,0)
"Correct."
(15.482538938522339,0)
"Correct."
(20.866790771484375,0)
"Correct."
(26.18815588951111,0)
"Correct."
(31.308336973190308,1)
"Correct."
(36.21953082084656,1)
Ensi kerralla käytämme tätä hyväksi, ja keräämme nämä tiedot niitä vastaaviin tietorakenteisiin.
-
Jotta tulostaulujen sisältöä päästään muuttamaan, tarvitaan siis viitteet näiden taulujen malleihin:
data GUI = GUI {
gBuffer :: TextBuffer,
gLabel1, gLabel2 :: Label,
gModelR :: ListStore Result,
gModelS :: ListStore Timing,
gModelI :: ListStore Interval
}
Nämä viitteet luotiin funktiossa createGUI:
rModel <- setupView rInitModel rColTitles rColFuncs innerVBox1
sModel <- setupView sInitModel sColTitles sColFuncs innerVBox1
iModel <- setupView iInitModel iColTitles iColFuncs innerVBox2
...
return GUI {
gBuffer = buffer,
gLabel1 = label1, gLabel2 = label2,
gModelR = rModel, gModelS = sModel, gModelI = iModel
}
S-taulun ainoa rivi (rivinumero 0) päivitetään nyt funktiolla listStoreSetValue. Sen parametrit ovat viite malliin (gModelS gui), rivinumero ja tietorakenne Timing, joka sisältää näytettävien kenttien saamat arvot.
renewTableS gui gs t = do
listStoreSetValue (gModelS gui) 0 Timing {
sSecsLeft = iLeft t,
sSession = mmss t,
sTotal = total gs,
sSpeed = 0.0
}
Ensimmäisen näppäimistönpainalluksen seurauksena kutsuttavaan funktioon whenNotStarted on lisätty komento timeoutAdd, joka käynnistää ajastimen.
whenNotStarted status gui settings lines pt gsRef gs = do
putStrLn ("Started with " ++ (show status))
timeoutAdd (onTimeout gui gsRef) 500
Ajastimen toiminta määritellään seuraavassa:
onTimeout gui gsRef = do
gs <- readIORef gsRef
pt <- getPOSIXTime
let t = secondsFrom (startTime gs) pt
iCur = iNumber t
renewTables gui gs t iCur
writeIORef gsRef gs {
lastShownIv = iCur
}
return True
Pienet apufunktiot iNumber ja iLeft kertovat jakson numeron ja paljonko jaksossa on sekunteja jäljellä.
iNumber t =
floor t `div` iDuration
iLeft t =
iDuration - (floor t `mod` iDuration)
Tilastoitavat näppäimistönpainallukset kerätään oikeisiin intervalleihin funktiossa addTime:
addTime status i intervals =
[newHead] ++ tail newIvs
where
newHead = case status of
Correct -> headIv { iMrks = (iMrks headIv) + 1 }
Error -> headIv { iErrs = (iErrs headIv) + 1 }
headIv = head newIvs
newIvs = if i /= latestIvNum intervals
then [zeroInterval { iNum = i }] ++ intervals
else intervals
Käytännössä nämä muodostavat kasvavan taulukon, jossa kenttä iNum kertoo jakson numeron, ja kentät iMrks ja iErrs lyöntimäärät ja virheet seuraavaan tapaan:
[Interval {iNum = 1, iMrks = 9, iErrs = 0},Interval {iNum = 0, iMrks = 68, iErrs = 2}]
Jatkamme tulostietojen käsittelemistä ensi kerralla. Ohjelmakoodi tähän mennessä http://personal.inet.fi/koti/jhii/ajanottoa-03.hs (http://personal.inet.fi/koti/jhii/ajanottoa-03.hs)
-
Tulostauluja on siis kolme, näistä istunnon S-taulu päivitetään puolen sekunnin välein. Kaksi muuta taulua päivitetään, kun siirrytään intervallista toiseen. Monadin sisällä tämä ehtolause ei ole kovin selkeästi luettava, mutta se on seuraavassa:
renewTables gui gs t iCur = do
renewTableS gui gs t
newGs <- if (lastShownIv gs /= iCur)
then renewSeldomTables gui gs iCur
else return gs
return newGs
Intervallien I-taulun päivityksen yhteydessä lasketaan kahden minuutin tulos ja siivotaan pois tarpeettomat intervallit:
renewTableI gui gs iCur = do
mapM
(\(a,b) -> listStoreSetValue (gModelI gui) (amountOfIntervals-a) b)
(zip [1..] showIvs)
return gs {
intervals = newIvs,
lastShownIv = iCur,
results = [zeroResult {
rMrks = sum [iMrks g | g <- showIvs]
}]
}
where
iMaxShow = iCur - 1
infimum = iMaxShow - amountOfIntervals + 1
iMinShow = max 0 infimum
iMinNeed = max 0 (infimum + 1)
newIvs = ivsFrom iMinNeed (intervals gs)
showIvs = reverse (ivsAllBetween iMinShow iMaxShow (intervals gs))
Näytettävien intervallien alaraja on muuttuja iMinShow ja yläraja iMaxShow. Seuraavaan kertaan näistä ei tarvitse säilyttää alarajan intervallia, joten tarvittavien intervallien alaraja iMinNeed on yhden korkeampi. Uudet intervallit ovat nyt siis taulukossa newIvs ja näytettävät intervallit taulukossa showIvs. Kahden minuutin tulos saadaan laskemalla merkkimäärät näytettävistä intervalleista kaavalla
rMrks = sum [iMrks g | g <- showIvs]
Tässä vaiheessa heitämme tuon laskun tuloksen yksinkertaisesti tulosten R-taulun alimmalle riville:
latestResult results = if null results
then zeroResult
else head results
renewTableR gui gs iCur = do
listStoreSetValue (gModelR gui) 2 (latestResult (results gs))
return ()
Pienet apufunktiot, joita käytämme intervallien suodattamiseen, ovat esitettynä seuraavassa. Intervalleihin ei taltioidu nollatuloksia, mutta I-taulussa ne halutaan näyttää, ja tästä syystä määrittelemme funktiot ivsAllBetween ja ivExactly.
ivsBetween iMin iMax ivs =
filter (\iv -> iMin <= (iNum iv) && (iNum iv) <= iMax) ivs
ivsFrom iMin ivs =
filter (\iv -> iMin <= (iNum iv)) ivs
ivsAllBetween iMin iMax ivs =
[ivExactly n ivs | n <- [iMin .. iMax]]
ivExactly n ivs =
case find (\iv -> n == (iNum iv)) ivs of
Just x -> x
Nothing -> zeroInterval { iNum = n }
Kirjoitusnopeus kauniissa muodossa merkkijonona esitettynä saatiin jakamalla merkkimäärä aikavälin pituudella (mrk/min, jossa 1min=60.0s).
rSpeed mrks =
f01 ((intToDouble mrks)* 60.0 / intToDouble rDuration)
Havaitsin, että olin aikaisemmin funktiossa addTime aika varomattomasti luottanut taulukon olevan ei-tyhjä. Olen korjannut tämän ja lisännyt joitakin muita virheitä lähdekoodiin.
if null intervals ||
Kokeiluversio löytyy täältä http://personal.inet.fi/koti/jhii/taulut-01.hs (http://personal.inet.fi/koti/jhii/taulut-01.hs)
(Koodaus UTF-8, mikäli jotkin merkit näkyvät väärin.)
-
Laskimme edellisellä kerralla intervallit, joilla on merkitystä tuloksen määräytymisessä. Nyt käytämme näiden intervallien taulukkoa parametrina, ja laskemme kyseisen tuloksen:
addResult showIvs gs = do
pt <- getPOSIXTime
tz <- getCurrentTimeZone
let newResult0 = zeroResult {
rDate = timeFormatted (utcToZonedTime tz (posixSecondsToUTCTime pt)),
rMrks = sum [iMrks g | g <- showIvs],
rErrs = sum [iErrs g | g <- showIvs]
}
let newResult = newResult0 {
rRank = tellRank newResult0 (results gs)
}
let
newRs = take maxRank (insert newResult (results gs))
newShownRs = [
bestResult newRs,
(sessionBest gs) `min` newResult,
newResult ]
return (newRs, newShownRs)
timeFormatted :: ZonedTime -> String
timeFormatted = formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S"
tellRank x xs =
case findIndex (x <=) xs of
Just n -> n + 1
Nothing -> length xs + 1
Muuttuja newResult0 on päivämäärän, merkkimäärän ja virhemäärän sisältävä nimetty tietue. Sitä tarvitaan välituloksena, jotta voimme selvittää mille sijalle tuloksissa saavutettu kirjoitusnopeus sijoittuu. Muuttuja newResult on vastaava tietue, johon on lisätty kyseinen sijoitus, rRank. Sijoitus saadaan funktiosta tellRank. Tulostauluun määrittelemme tilaa viidelletuhannelle tulostietueelle. Uusi tulos lisätään oikeaan kohtaan taulukkoon newRs funktiolla insert, ja tämän jälkeen taulukko typistetään tulostaulun maksimipituuteen funktiolla take.
Tulosten vertaileminen toisiinsa perustuu tyyppiluokkien Eq ja Ord hyväksikäyttöön. Kirjastosta List löytyy koko joukko funktioita, jotka osaavat käyttää tätä ominaisuutta hyväksi, esimerkiksi funktio insert. Luomme tietorakenteelle Result instanssin näihin tyyppiluokkiin. Tuloksia kohdellaan samana, mikäli niiden merkkimäärä ja päivämäärä ovat samat. Samaan merkkimäärään päädyttäessä aikaisemmin saavutettua tulosta pidetään parempana verrattuna myöhemmin saavutettuun. Virhemäärä on mukana ainoastaan informaation vuoksi.
data Result = Result {
rDate :: String,
rMrks, rRank, rErrs :: Int
} deriving (Read, Show)
instance Eq Result where
(Result a b c d) == (Result aa bb cc dd) =
b == bb && a == aa
instance Ord Result where
(Result a b c d) `compare` (Result aa bb cc dd) =
if (b == bb) then (a `compare` aa) else (bb `compare` b)
Funktio addResult palauttaa päivitetyn tulostaulun lisäksi toisena tietueen alkiona taulukon newShownRs, johon on laskettuna kolme erityistä tulosta näytettäväksi ruudulla:
newShownRs = [
bestResult newRs,
(sessionBest gs) `min` newResult,
newResult ]
bestResult results = if null results
then zeroResult
else head results
Ensimmäinen näistä on kaikkien aikojen paras tulos, toinen istunnon paras tulos ja kolmas viimeisin tulos. Näistä kaikkien aikojen paras tulos on sama kuin istunnon paras tulos, sillä emme toistaiseksi lainkaan tallenna tuloksia. Myös tässä funktio min käyttää hyväksi järjestysominaisuutta, joka on seurausta tyyppiluokkiin Eq ja Ord kuulumisesta.
Jätimme aikaisemmin toteuttamatta S-taulun sarakkeen "Jaksonopeus" laskemisen. Tulin ajatelleeksi, että ehkä sittenkin laskemme tuohon sarakkeeseen hetkellisen nopeuden kymmenen viimeisen sekunnin osalta. Muutamme S-taulun päivitysalgoritmia saadaksemme tarvittavat tiedot talteen:
renewTableS gui gs t = do
pt <- getPOSIXTime
let newGs = gs {
speedNows = [(pt, (total gs))] ++ take speedCount (speedNows gs)
}
let s = difs (speedNows newGs)
listStoreSetValue (gModelS gui) 0 Timing {
sSecsLeft = iLeft t,
sSession = mmss t,
sTotal = total gs,
sSpeed = speed (snd s) (fst s)
}
putStrLn (show (snd s) ++ " merkkiä " ++ f01 (fst s) ++ " sekunnissa")
return newGs
Tässä speedNows gs on taulukko, johon keräämme kellonajan ja kellonaikaa vastaavan kokonaismerkkimäärän total gs. Kun nyt laskemme näiden kunkin erotuksen taulukon alusta ja lopusta, saamme hetkellisen kirjoitusnopeuden:
difs speds =
if null speds
then (0.0, 0)
else (secondsFrom (fst start) (fst end), (snd end) - (snd start))
where
start = last speds
end = head speds
speed mrks t =
(intToDouble mrks) * 60.0 / (max t 1.0)
Olen tässä jälleen käyttänyt epämääräisiä keinoja huolehtimaan, ettei synny nollalla jakoa tai pään etsimistä tyhjästä listasta.
Ohjelmakoodi tähän mennessä http://personal.inet.fi/koti/jhii/taulut-02.hs (http://personal.inet.fi/koti/jhii/taulut-02.hs)
-
Kirjasin muutetaan funktiossa setFonts, missä vaadittava parametri fontstring saa arvon "monospace". Tekstin kokoa voi muuttaa lisäämällä merkkikoon, esimerkiksi "monospace 12". Tasalevyistä kirjoituskonekirjasinta tarvitaan, jotta voimme tyhjentää merkkijonon välilyönneillä kun käyttäjä kirjoittaa sitä. Toinen vaihtoehto olisi piirtää merkkijonot itse, jolloin käyttäisimme funktiota textExtents selvittämään tyhjennettävän osuuden dimensiot. Tämä mahdollistaisi myös muiden kirjasimien käytön.
setFonts gui fontstring = do
srcfont <- fontDescriptionFromString fontstring
widgetModifyFont (gLabel1 gui) (Just srcfont)
widgetModifyFont (gLabel2 gui) (Just srcfont)
widgetModifyFont (gTextview gui) (Just srcfont)
Olkoon nyt n kirjoitettujen merkkien lukumäärä. Näytettävä merkkijono on tällöin n kappaletta välilyöntejä lisättynä merkkijonon häntään, joka jää jäljelle pudottamalla n merkkiä pois alusta:
blankStart n str =
replicate n ' ' ++ drop n str
Käytämme hyväksemme funktiota commonPrefix, ja teemme tarvittavat muutokset puskurin muutokseen vastaavaan tapahtumankäsittelijään whenBufferChanged:
cprfix = length (commonPrefix txt label1Str)
set (gLabel1 gui) [
labelLabel := blankStart cprfix label1Str]
Ohjelman peruslogiikka alkaa olla valmiina, kunhan vielä tallennamme tulokset. Olemme aikaisemmin määritelleet tulostietotyypin periytymään tyyppiluokista Show ja Read, joten tietorakenteen lukeminen ja kirjoittaminen on automaattista. Periaattessa tulokset luetaan yksinkertaisten funktioiden readFile ja read avulla.
Vanhoja tuloksia lukiessamme saatamme todennäköisesti törmätä kahteen ongelmaan: tulostiedostoa ei ole olemassa tai tulostiedot eivät ole jäsenneltävässä muodossa. Kirjastossa System.IO.Error on funktio try, joka sopii virheenhallintaan. Tyyppiä IO a olevalle parametrille se palauttaa arvon tyyppiä IO (Either IOError a), joka on Left e virheen sattuessa ja Right i muutoin. Emme tässä ole kiinnostuneita virheen laadusta, vaan palautamme tyhjän tulostaulukon:
resultsFromFile fname = do
opResult <- try ( do
content <- readFile fname
readLst content )
case opResult of
Left excp -> return []
Right val -> return val
readLst :: String -> IO [Result]
readLst = readIO
Kaikenkaikkiaan alustustietojen luomiseen ja lukemiseen käytettävä funktio getStartupConfig näyttää tässä vaiheessa seuraavalta. Oletuksena on, että ohjelman käyttämät tiedostot tallennetaan vastedes piilohakemistoon "/home/user/.hatupist/", joka luodaan, jollei sitä ole:
getStartupConfig gui gsRef = do
gs <- readIORef gsRef
-- directory
homedir <- getHomeDirectory
let dir = homedir ++ "/.hatupist"
createDirectoryIfMissing False (dir)
-- savedResults
let rname = dir ++ "/" ++ resultsFile
oldResults <- resultsFromFile rname
putStrLn ("Reading " ++ rname ++ ": " ++ show (length (oldResults)) ++ " rows")
listStoreSetValue (gModelR gui) 0 (bestResult oldResults)
-- other
setFonts gui "monospace"
writeIORef gsRef gs {
homeDirectory = dir,
results = oldResults
}
resultsFile = "results.txt"
Vastaavasti tulokset tallennetaan ohjelman päättyessä funktioiden writeFile ja show avulla:
quitProgram gsRef = do
print "Quitting."
gs <- readIORef gsRef
let rname = (homeDirectory gs) ++ "/" ++ resultsFile
writeFile rname (show (results gs))
putStrLn ("Saving " ++ rname)
mainQuit
Ohjelmakoodi tähän mennessä: http://personal.inet.fi/koti/jhii/savedResults-01.hs (http://personal.inet.fi/koti/jhii/savedResults-01.hs)
Ohjelman ikkuna näyttää nyt tältä:
(http://personal.inet.fi/koti/jhii/Hatupist_012.png)
-
Ohjelman versioissa tähän asti olemme välittäneet funktion tarvitsemat tiedot parametreina, esimerkiksi:
whenBufferChanged gui settings lines gsRef = do
Lukuisten kokeiluiden seurauksena päädyin luopumaan tästä tavasta ja siirtämään parametrit tietorakenteen State alaisuuteen. Funktiokutsut tulevat tällöin muotoon
whenBufferChanged gsRef = do
...
Tietorakenne State sisältää nyt muun muassa seuraavat kentät:
data State = State {
textLines :: [String],
speedNows :: [(POSIXTime, Int)],
intervals :: [Interval],
results :: [Result],
settings :: Settings,
gui :: GUI
}
Säästääksemme hieman kirjoitusvaivaa, määrittelemme seuraavat lyhennysmerkinnät:
s gs = settings gs
g gs = gui gs
r gs = results gs
Voimme nyt kutsua tietorakenteen State sisältämiä kenttiä seuraavaan tapaan:
textfile (s gs)
lineLen (s gs))
gModelR (g gs)
gBuffer (g gs)
...
En ole täysin varma, onko tekemäni muutos huononnus vai parannus lopputulokseen. Kuitenkin esimerkiksi asetusten lukeminen ja kirjoittaminen onnistuu nyt varsin yksinkertaisesti:
-- lukeminen:
let rname = dir ++ "/" ++ settingsFile
oldSettings <- settingsFromFile rname
putStrLn ("Reading " ++ rname)
-- kirjoittaminen:
let rname = (homeDirectory gs) ++ "/" ++ settingsFile
writeFile rname (show (s gs))
putStrLn ("Writing " ++ rname)
Lisäsin koodiin dialogi-ikkunat rivinpituuden, tekstitiedoston ja kirjasimen valitsemiseksi. Näistä esimerkkinä kirjasimen valinta:
openFont gsRef = do
gs <- readIORef gsRef
result <- chooseFont "Valitse kirjasin" (font (s gs))
case result of
Just newFont -> do
writeIORef gsRef gs {
settings = (s gs) {
font = newFont }}
setFonts gsRef
otherwise -> return ()
chooseFont prompt oldFont = do
dialog <- fontSelectionDialogNew prompt
fontSelectionDialogSetFontName dialog oldFont
widgetShow dialog
response <- dialogRun dialog
print response
case response of
ResponseOk -> do
fn <- fontSelectionDialogGetFontName dialog
widgetDestroy dialog
return fn
ResponseCancel -> do
widgetDestroy dialog
return Nothing
ResponseDeleteEvent -> do
widgetDestroy dialog
return Nothing
_ -> return Nothing
Nämä dialogi-ikkunat on yhdistetty pääohjelman valikkoon seuraavasti:
menuBarDescr =
[("_Tiedosto",
[("gtk-open", openFile),
("gtk-select-font", openFont),
("gtk-preferences", setPreferences),
("gtk-about", resultsCSV),
("gtk-quit", quitProgram)])
]
Aikaisemmin huomiotta jäänyt asia oli myös, että vanhojen tulosten sijoitukset luonnollisesti muuttuvat kun uusia syntyy:
reRank1 (Result { rDate = a, rMrks = b, rRank = c, rErrs = d }, newRank) =
Result { rDate = a, rMrks = b, rRank = newRank, rErrs = d }
reRank rs = map reRank1 (zip rs [1..])
Lähdekoodi kokonaisuudessaan: http://personal.inet.fi/koti/jhii/asetukset-02.hs (http://personal.inet.fi/koti/jhii/asetukset-02.hs)
-
Virheen sattuessa näytetään varoitusraita, jonka on tarkoitus olla visuaalisesti riittävän häiritsevä kirjoittamisen pysäyttämiseksi. Alkuperäisessä ohjelmassa käytin Gimpillä maalattua mustakeltaista PNG-kuvaa Image-komponentissa. Tällä kertaa annamme ohjelman piirtää raidat DrawingArea-komponentille. Olen tähän valinnut punaiset ja siniset raidat, mutta värejä on helppo muuttaa koodista.
Lopputulos tulee näyttämään jotakuinkin tältä:
(http://personal.inet.fi/koti/jhii/Hatupist_013.png)
Luonnollinen paikka piirtorutiinin käynnistämiseen on funktiossa whenBufferChanged. Tieto virheestä sisältyy gsRef-viitteeseen, joten selviämme komennolla widgetQueueDraw canvas, missä canvas on viittaus DrawingArea-komponenttiin. Se luodaan funktiossa createGUI:
canvas <- drawingAreaNew
widgetSetSizeRequest canvas 300 40
onExpose canvas (
drawCanvas gsRef canvas)
boxPackStart outerVBox canvas PackGrow 0
Nyt siis komento widgetQueueDraw aiheuttaa funktion onExpose kutsun, joka on jaettu kahteen osaan, riippuen siitä piirretäänkö tyhjä vai näkyvä komponentti. Tyhjän komponentin piirtäminen on triviaali toimenpide, joka perustuu järjestelmän taipumukseen päivittää komponentit alkuperäisasetuksiin.
drawCanvas gsRef canvas _evt = do
gs <- readIORef gsRef
if (oldStatus gs) /= Error
then drawCanvas0 canvas _evt
else drawCanvas1 canvas _evt
drawCanvas0 canvas _evt = do
return True
drawCanvas1 canvas _evt = do
(w,h) <- widgetGetSize canvas
dw <- widgetGetDrawWindow canvas
gc1 <- gcNew dw
gc2 <- gcNew dw
gcSetValues gc1 newGCValues { foreground = red }
gcSetValues gc2 newGCValues { foreground = blue }
let c = h
r = 15
limit0 = -1 - c `div` r
limit1 = (w+c) `div` r + 1
mapM
( \(points,gc) -> drawPolygon dw gc True points)
[([(x*r+c,0),(x*r,h),((x+1)*r,h),((x+1)*r+c,0)],
if x `mod` 2 == 0 then gc1 else gc2) | x <- [limit0..limit1]]
return True
Piirtorutiinit, kuten tavallisesti, menevät minulla lukukelvottomaksi sekasotkuksi, mutta ajatus on siinä, että vuorotellaan grafiikkakonteksteja gc1 ja gc2, jotka tässä ovat punainen ja sininen kynä. Kukin raita on monikulmio (drawPolygon), jonka alakoordinaattien x-arvot poikkeavat vakion c verran yläkoordinaateista, aiheuttaen monikulmion kallistumisen. Vakio r määrää yhden raidan leveyden pikseleinä.
Punainen ja sininen väri ovat red ja blue, jotka olen määritellyt seuraavasti:
color r g b = Color (r*256) (g*256) (b*256)
green = color 115 210 22
red = color 255 51 102
blue = color 51 102 255
yellow = color 252 233 79
Kun erilaisia värejä on nyt koko joukko määriteltynä, voimme tehdä niiden avulla vaikkapa pienen väriefektin Tietoja-valikon tulostietodialogiin. Se värittää tekstirivin vihreäksi kun CSV-muotoinen tulosluettelo tallennetaan. Label-komponentti ei sisällä tietoa taustaväristä, joten upotamme sen EventBox-komponenttiin, ja muutamme sen taustavärin vihreäksi:
onSaveClicked fname text label = do
writeFile fname text
labelSetText label ("Kirjoitettiin " ++ fname)
parent <- widgetGetParent label
case parent of
Nothing -> print "No parent"
Just parent -> widgetModifyBg parent StateNormal (green)
return ()
Yksi tärkeä muutos ohjelmaan on varautua virheisiin tekstitiedostoa luettaessa, esimerkiksi tiedoston puuttumiseen aloitettaessa. Tämän vuoksi sisällytämme readFile-käskyn try-rakenteeseen, samaan tapaan kuin aikaisemmin tuloksia ja asetuksia luettaessa. Tiedoston luvun epäonnistuessa näytämme yksinkertaisen virhedialogin ja palautamme epämääräisen joukon valmiiksi määriteltyjä latinankielisiä sananlaskuja (ei kuvassa).
tryReadFile fname = do
opResult <- try ( do
text <- readFile fname
return text)
case opResult of
Left excp -> return (
(unlines proverbs),
Just ("Tiedostoa " ++ fname ++ " ei voitu lukea."))
Right text -> return (text, Nothing)
showErrorDialog txt gsRef = do
gs <- readIORef gsRef
let parent = Just (gWindow (g gs))
dialog <- messageDialogNew parent [] MessageWarning ButtonsOk "Avaa tiedosto"
messageDialogSetSecondaryText dialog txt
dialogRun dialog
widgetDestroy dialog
getLines gsRef = do
gs <- readIORef gsRef
(originalText, err) <- tryReadFile (textfile (s gs))
...
case err of
Nothing -> return ()
Just txt -> showErrorDialog txt gsRef
Ohjelmakoodi kokonaisuudessaan: http://personal.inet.fi/koti/jhii/varoitusraidat.hs (http://personal.inet.fi/koti/jhii/varoitusraidat.hs)
Tässä vielä hieman ohjeita ohjelman kääntämiseksi GHC-kääntäjällä.
Tulkattavassa muodossa ohjelma käynnistettiin komennolla
runhaskell varoitusraidat.hs
Nimetään ensin lähdetiedosto hieman asiallisemmin:
mv varoitusraidat.hs hatupist.hs
Yksinkertainen käännösprosessi tuottaa valtaisan 18 megatavun tiedoston:
$ ghc hatupist.hs
[1 of 1] Compiling Main ( hatupist.hs, hatupist.o )
Linking hatupist ...
$ ll hatupist
-rwxrwxr-x. 17996645 29.7. 22:09 hatupist
Tässä kaikki GTK-kirjastot on linkitettynä ohjelmaan. Voimme jättää ne pois kääntämällä ohjelma komennolla ghc -O2 -dynamic (Valitsin on O-kirjain, ei nolla), jolloin päädymme alle neljäsataakiloiseen ohjelmaan.
$ ghc -O2 -dynamic hatupist.hs
[1 of 1] Compiling Main ( hatupist.hs, hatupist.o )
Linking hatupist ...
$ ll hatupist
-rwxrwxr-x. 357132 29.7. 22:15 hatupist
Komennolla strip ohjelmasta saa vieläkin ylimääräistä pois:
$ strip hatupist
$ ll hatupist
-rwxrwxr-x. 239176 29.7. 22:18 hatupist
$ rm hatupist.hi hatupist.o
$ ./hatupist
-
Niitä varten, jotka eivät vielä osaa kymmensormijärjestelmää, saattaisi olla hyvä laatia jonkinlainen avustava näppäimistönkuva, josta näkisi näppäimen sijainnin, mikäli ei satu sitä muistamaan. Päädyin tekemään tämän osan erillään varsinaisesta ohjelmasta, sillä en vielä tiedä, minkä verran komponentti tulee vaatimaan esimerkiksi mahdollisuutta muokata asetuksia, kuten käytettävää näppäimistökarttaa.
Komponentti näyttää tältä:
(http://personal.inet.fi/koti/jhii/Hatupist_015.png)
Siinä on eroteltuna sormien alueet omilla väreillään, ja vuorossa oleva A-kirjain on korostettu negatiivisella taustalla.
Näppäimistökartoista DAS ja QWERTY on valmiiksi määriteltyjä:
das = [
"phrkz'wuybq",
"slntvgaioec",
"fxdmjåöä,.-"]
qwerty = [
"qwertyuiopå",
"asdfghjklöä",
" zxcvbnm,.-"]
Eri väreillä tulevat alueet on määritelty qwertyn avulla.
qwertyAreas = ["rfvujm", "edcik,", "wsxol.", "qazpö-"]
areaColors = [blue, green, red, yellow]
Nyt siis paikassa (x,y) olevan näppäimen "qwertyarvo" ja sitä vastaava väri saadaan funktioista
qwertyColor letter =
if null as then Nothing else Just (areaColors !! (head as))
where
as = [a |(a,i) <- zip [0..] qwertyAreas, letter `elem` i]
qwertyLetter x y =
if y < length qwerty && x < length (qwerty!!y)
then (qwerty !! y) !! x
else ' '
Piirtoalueena on jälleen DrawingArea-komponentti. Sen koko on 275x78 pikseliä, ja onExpose-tapahtumankäsittelijä huolehtii alueen uudelleenpiirrosta kutsumalla myöhemmin määrittelemäämme funktiota drawCanvas.
canvas <- drawingAreaNew
widgetSetSizeRequest canvas 275 78
onExpose canvas (
drawCanvas canvas gsRef)
boxPackStart vbox canvas PackGrow 0
Taustavärit piirretään täytettyinä suorakulmioina funktiossa drawBottom. Niitä varten luodaan uusi piirtokonteksti gc, jonka väri saa parametrin c arvon.
drawBottom dw xx yy r c = do
gc <- gcNew dw
gcSetValues gc newGCValues { foreground = c }
drawRectangle dw gc True xx yy r r
Yksittäinen näppäin piirretään funktiossa drawKey. Sille välitetään piirtokontekstit gc1 ja gc2, joista ensimmäinen on normaalivärein piirrettävä näppäin ja toinen on negatiivisin värein piirrettävä näppäin. GTK-kirjaston asemointimäärittelyt huolehtivat kirjaimen keskittämisestä laatikkoonsa. Laatikon sivun pituus on r1 = 20 ja ympäröivä tila mukaanlukien r2 = 23. Jokaisen rivin yksilöllinen etäisyys vasemmasta laidasta on kerrottuna taulukossa deltaX = [3,12,0].
drawKey canvas dw gc1 gc2 x y letter selected = do
let co = qwertyColor(qwertyLetter x y)
gc = if selected then gc2 else gc1
case co of
Just c -> drawBottom dw (zentr xx) (zentr yy) r2 c
Nothing -> return ()
when selected (drawRectangle dw gc1 True xx yy r1 r1)
drawRectangle dw gc False xx yy r1 r1
layout <- widgetCreateLayout canvas letter
layoutSetAlignment layout AlignCenter
layoutSetWidth layout (Just (fromIntegral r1))
drawLayout dw gc xx (yy+3) layout
where
r1 = 20
r2 = 23
zentr z = z - (r2-r1) `div` 2
deltaXs = [3,12,0]
margin = 5
xx = x*r2+deltaXs!!y + margin
yy = y*r2
Olen oheisessa ohjelmassa tuttuun tapaan käyttänyt viittausta globaaliin muuttujarakenteeseen gsRef välittämään valittuna olevan näppäimen tiedot ajastimelta piirtorutiineille. Tällä kertaa gsRef sisältää ainoastaan parin, jonka ensimmäinen alkio on ajastimeen liittyvä järjestysluku ja toinen alkio valittuna oleva kirjain annetusta merkkijonosta text.
onTimeout canvas gsRef = do
(i,c) <- readIORef gsRef
widgetQueueDraw canvas
let j = (i+1) `mod` (length text)
writeIORef gsRef (j, text!!j)
return True
Ohjelmakoodi: http://personal.inet.fi/koti/jhii/avustaja-02.hs (http://personal.inet.fi/koti/jhii/avustaja-02.hs)
-
Tämänkertaiseen versioon olen lisännyt ikkunan alalaitaan tilarivin. Se on Label-komponentti, joka on upotettu EventBox-komponenttiin, jotta sen taustaväriä voidaan muuttaa. Toiminnaltaan se vastaa aikaisemmin dialogi-ikkunaan tekemäämme ilmoitusriviä. Tilarivin teksti ja väri muutetaan ohjelmassa määritellyllä funktiolla setStatusText text color gs, jossa ensimmäinen parametri on näytettävä teksti tyyliin "Voit aloittaa.", "Korjaa virheet!", tms. ja toinen parametri on taustaväri, esimerkiksi green tai red, jotka määrittelimme aikaisemmin. Taustaväri jätetään huomiotta jos teksti on tyhjä merkkijono "", jolloin käytetään komponentin oletustyyliä. Oletustyyli otettiin talteen ikkunaa luodessa komennolla style <- widgetGetStyle window, ja se sijaitsee globaalimuuttujan gs kentässä gStyle gui.
Tilarivin lisäksi aloin kaipaamaan ohjelmaan jonkinlaista visuaalista ilmaisinta aina kun kolmenkymmenen sekunnin jaksot kuluvat umpeen ja uudet tulokset päivitetään. Tähän tarkoitukseen luomme uuden piirtoalueen tulostaulujen vasemman palstan alle:
timingCanvas <- drawingAreaNew
widgetSetSizeRequest timingCanvas 300 3
onExpose timingCanvas (
drawTimingCanvas gsRef timingCanvas)
boxPackStart innerVBox1 timingCanvas PackGrow 0
Se on käytännössä kapea kolmen pikselin väriviiva, joka silloin tällöin ilmestyy ruudulle. Tämä piirtoalue päivitetään jota kuinkin samaan tapaan kuin aikaisemmin piirrettiin virheilmaisimen varoitusraidoitus. Piirtoalueen tyhjentämiseen ne molemmat käyttävät määrittelemäämme funktiota drawEmptyPicture canvas.
Funktiot, jotka päättävät piirretäänkö kuva vai tyhjä tausta, ovat nimeltään drawErrorCanvas (virheilmaisimen tapauksessa) ja drawTimingCanvas (tulospäivityksen tapauksessa). Tulospäivitys käyttää globaalia muuttujaa showTimingPict, joka saa arvon True kun tulostaulujen sisältöä muutetaan, sekä arvon False päivitystarpeen poistuessa kun kuva on piirretty. Kun kuva piirretään, käynnistetään samalla ajastin timeoutAdd (onTimeToClear canvas) 1000, joka sekunnin kuluttua poistaa kuvan ruudulta.
Kuvan piirtoon liittyvät rutiinit ovat funktioissa drawErrorPicture (varoitusraidat) ja drawTimingPicture (tulospäivitys). Näistä jälkimmäinen seuraavassa:
drawTimingPicture gs canvas = do
row <- listStoreGetValue (gModelR (g gs)) 2
(w,h) <- widgetGetSize canvas
dw <- widgetGetDrawWindow canvas
gc1 <- gcNew dw
let r = rRank row
k = (d-1) `min` floorLogBase 3 (r+1)
gcSetValues gc1 newGCValues { foreground = colors !! k }
drawRectangle dw gc1 True 0 0 w h
timeoutAdd (onTimeToClear canvas) 1000
return True
where
colors = [grtd0, grtd1, grtd2, grtd3, grtd4, grtd5, grtd6]
d = length colors
floorLogBase :: Int -> Int -> Int
floorLogBase base n =
floor (logBase (fromIntegral base) (fromIntegral n))
Piirtoalueelle ilmestyvä kapea suorakulmio väritetään tässä siis eri värillä sen mukaan miten hyvä tulos sattui olemaan. Asteikko on logaritminen ja heikoimmat tulokset pakotetaan viimeisen värin alueelle. Lopputulos ei välttämättä olisi ollut näin pitkän koodin arvoinen, ehkä löydämme myöhemmin paremman tavan hoitaa asia.
Ohjelmakoodi kokonaisuudessaan: http://personal.inet.fi/koti/jhii/tilarivi.hs (http://personal.inet.fi/koti/jhii/tilarivi.hs)
-
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:
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:
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ä:
(http://personal.inet.fi/koti/jhii/Asetukset_001.png)
Näkymä luodaan samaan tapaan kuin aikaisemmin, mutta sarakenumero i välitetään parametrina.
mapM
( \(title, i) -> newcol view model title i )
( zip colTitle [0..] )
Sarakenumeron ollessa 1, solusta tehdään muokattava:
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.
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
([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 (http://personal.inet.fi/koti/jhii/asetukset-03.hs)
-
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:
readInt :: String -> IO Int
readInt s = readIO s
Vastaavasti merkkijonon jäsentäminen totuusarvoksi (True tai False) tapahtuu funktiolla
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:
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:
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:
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:
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 (http://personal.inet.fi/koti/jhii/asetukset-04.hs)
-
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:
$ 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:
(http://personal.inet.fi/koti/jhii/variteemat_016.png)
Ohjelmakoodi on löydettävissä osoitteesta
http://personal.inet.fi/koti/jhii/variteemat-03.hs (http://personal.inet.fi/koti/jhii/variteemat-03.hs)
-
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.
(http://personal.inet.fi/koti/jhii/Hatupist_019.png)
Koodista muutokset löytyvät pääosin hakusanalla Entry, mutta tässä muutama esiteltynä:
miscSetPadding label1 2 0
Label-komponenttien sisennys on kaksi pikseliä, jolloin tekstit asettuvat täsmällisesti allekkain.
entrySetHasFrame entry False
Poistaa Entry-komponentin hankalan kehyksen.
entrySetText (gEntry (g gs)) ""
Tyhjentää syöterivin.
txt <- entryGetText (gEntry (g gs))
Lukee tekstin syöteriviltä.
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 (http://personal.inet.fi/koti/jhii/entry-01.hs)
-
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:
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 (http://personal.inet.fi/koti/jhii/korjauksia-01.hs)
Ajatuksenani oli vielä piirrellä grafiikoita tulosten kehityksestä ajan kuluessa, ehkä palaamme siihen vielä myöhemmin.
-
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:
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ä:
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.
-
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.
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ä.
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.
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ä:
(http://personal.inet.fi/koti/jhii/frames-02.png)
-
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:
(http://personal.inet.fi/koti/jhii/wing_002.png)
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.
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.
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.
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ä:
(http://personal.inet.fi/koti/jhii/ruksit-01.png)
-
Piirretään vielä mitta-asteikot ja selitteet. Mitta-asteikkoa varten tarvitaan minimi- ja maksimiarvot kuvaajasta. Ne periaatteessa laskettiin jo viimeksi.
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.
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.
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).
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.
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.
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ä.
(http://personal.inet.fi/koti/jhii/tulokset.png)
Kun kuvan koko on aseteltu sopivaksi, se talletetaan hiiren oikealla painikkeella tiedostoon "tulokset.png". Tämä tapahtuu asettamalla tapahtumankäsittelijä funktioon main.
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
-
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.
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ä:
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
-
Kerätään seuraavaksi muutama kirjoitustestin tuloksista laadittu kuva pieneen ikkunaan, joka on tarkoitus myöhemmin liittää osaksi pääohjelmaa.
(http://personal.inet.fi/koti/jhii/ruksit-06.png)
Vertailtavat suureet on koottuna listaan framelist, joka sisältää tietueina viiden kuvan piirtämiseen tarvittavat selitteet ja funktiot:
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".
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.
data Result = Result {
rDate :: String,
rMrks, rRank, rErrs :: Int
} deriving (Read, Show)
Vastaavasti virheprosentti ja nopeus saadaan funktioilla errorProsResult ja speedResult.
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.
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ä.
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.
> zip [1..] "abcd"
[(1,'a'),(2,'b'),(3,'c'),(4,'d')]
Piirtämisen nopeuttamiseksi aikaisemmat ruksit on korvattu suorakulmioilla.
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.
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
-
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
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:
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.
intToDouble :: Int -> Double
intToDouble i = fromRational (toRational i)
Tällöin piirtorutiini näyttää jotakuinkin tältä:
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
-
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.